:- module(ascii_rewrite, [convert_ascii/0, convert_quarter/2 ]). :- use_module(library(csvrdf)). :- use_module(library(semweb/rdf_db)). :- use_module(library(semweb/rdf_turtle_write)). :- use_module(library(xmlrdf/rdf_rewrite)). :- use_module(library(xmlrdf/rdf_convert_util)). :- rdf_meta code_to_uri(+,+,r). :- dynamic table_map/3. user:file_search_path(ascii, '../fda_data/ascii'). user:file_search_path(ascii_rdf, '../rdf/aers_ascii'). filename('Report', 'DEMO'). filename('Drug', 'DRUG'). filename('Reaction', 'REAC'). filename('Outcome', 'OUTC'). filename('Source', 'RPSR'). filename('Therapy', 'THER'). filename('Indication', 'INDI'). :- debug(csvrdf). quarter('04Q1'). quarter('04Q2'). quarter('04Q3'). quarter('04Q4'). quarter('05Q1'). quarter('05Q2'). quarter('05Q3'). quarter('05Q4'). quarter('06Q1'). quarter('06Q2'). quarter('06Q3'). quarter('06Q4'). quarter('07Q1'). quarter('07Q2'). quarter('07Q3'). quarter('07Q4'). quarter('08Q1'). quarter('08Q2'). quarter('08Q3'). quarter('08Q4'). quarter('09Q1'). quarter('09Q2'). quarter('09Q3'). quarter('09Q4'). quarter('10Q1'). quarter('10Q2'). quarter('10Q3'). quarter('10Q4'). quarter('11Q1'). quarter('11Q2'). quarter('11Q3'). quarter('11Q4'). quarter('12Q1'). quarter('12Q2'). convert_ascii :- ( quarter(Q), atom_concat(aers, Q, Graph), atom_concat(Graph, '.ttl', RDF_FileName), absolute_file_name(ascii_rdf(RDF_FileName), RDF_File), convert_quarter(Q, Graph), debug(csvrdf, 'save ~w to ~w', [Graph, RDF_File]), rdf_save_turtle(RDF_File, [graph(Graph)]), debug(csvrdf, 'remove ~w', [Graph]), rdf_retractall(_,_,_,Graph), fail ; true ). convert_quarter(Quarter, Graph) :- ascii_to_rdf(Quarter, Graph), rewrite_graph(Graph). ascii_to_rdf(Quarter, Graph) :- rdf_current_ns(aers, Prefix), FileExt = '.TXT', ( filename(Class, FilePrefix), concat_atom([FilePrefix,Quarter,FileExt], FileName), absolute_file_name(ascii(FileName), File), debug(csvrdf, 'convert ~w to ~w', [FileName, Graph]), load_csv_as_rdf(File, [prefix(Prefix), class(Class), graph(Graph), separator(0'$), match_arity(false) ]), fail ; true ). rewrite_graph(Graph) :- debug(csvrdf, 'rewrite ~w', [Graph]), rdf_rewrite(Graph). % report report_uri @@ {S, rdf:type, aers:'Report'}, {S, aers:isr, literal(Id)}\ {S} <=> id_to_uri(Id, aers_r, URI), {URI}. report_properties @@ {S, rdf:type, aers:'Report'}\ {S, aers:image, _}?, {S, aers:i_f_cod, literal(Follow)}?, {S, aers:rept_cod, literal(Type)}?, {S, aers:occp_cod, literal(Reporter)}? <=> code_to_uri(followup, Follow, Follow_URI), code_to_uri(type, Type, Type_URI), code_to_uri(reporter, Reporter, Reporter_URI), {S, aers:followup_status, Follow_URI}, {S, aers:report_type, Type_URI}, {S, aers:reporter_type, Reporter_URI}. % patient patient @@ {S, rdf:type, aers:'Report'}\ {S, aers:gndr_cod, literal(GND)}?, {S, aers:age, A}?, {S, aers:age_cod, literal(AC)}?, {S, aers:wt, W}?, {S, aers:wt_cod, literal(WC)}?, {S, aers:death_dt, D}? <=> at_least_one_given([GND,A,W,D]), code_to_uri(gender, GND, Gender), code_to_uri(age, AC, A_URI), code_to_uri(weight, WC, W_URI), {S, aers:patient, bnode([ aers:gender = Gender, aers:age = A, aers:age_type = A_URI, aers:weight = W, aers:weight_type = W_URI, aers:death_dt = D ]) }. % drug % % aers:drug_seq is replaced by drug_id so that we can quickly find drugs % later on drug_uri @@ {S, rdf:type, aers:'Drug'}, {S, aers:isr, literal(ISR)}, {S, aers:drug_seq, literal(Drug_Seq)}\ {S} <=> id_to_uri(ISR, aers_r, R), id_to_uri(Drug_Seq, aers_d, D), {D}, {R, aers:drug, D}. drug_properties @@ {S, rdf:type, aers:'Drug'}\ {S, aers:isr, _}, {S, aers:role_cod, literal(Role)}?, {S, aers:val_vbm, literal(Type)}?, {S, aers:dechal, literal(DChal)}?, {S, aers:rechal, literal(RChal)}? <=> code_to_uri(role, Role, Role_URI), code_to_uri(name_type, Type, Type_URI), code_to_uri(chal, DChal, DChal_URI), code_to_uri(chal, RChal, RChal_URI), {S, aers:role, Role_URI}, {S, aers:name_type, Type_URI}, {S, aers:dechal, DChal_URI}, {S, aers:rechal, RChal_URI}. % reaction reaction @@ {S, rdf:type, aers:'Reaction'}, {S, aers:isr, literal(ISR)}, {S, aers:pt, Term} <=> id_to_uri(ISR, aers_r, R), {R, aers:reaction, Term}. % outcome outcome @@ {S, rdf:type, aers:'Outcome'}, {S, aers:isr, literal(ISR)}, {S, aers:outc_cod, literal(Code)} <=> id_to_uri(ISR, aers_r, R), code_to_uri(outcome, Code, URI), {R, aers:outcome, URI}. % source source @@ {S, rdf:type, aers:'Source'}, {S, aers:isr, literal(ISR)}, {S, aers:rpsr_cod, literal(Code)} <=> id_to_uri(ISR, aers_r, R), code_to_uri(source, Code, URI), {R, aers:source, URI}. % Therapy therapy @@ {S, rdf:type, aers:'Therapy'}, {S, aers:drug_seq, literal(DrugSeq)}, {S, aers:isr, _} <=> id_to_uri(DrugSeq, aers_d, D), {D, aers:therapy, S}. % Indications indication @@ {S, rdf:type, aers:'Indication'}, {S, aers:drug_seq, literal(DrugSeq)}, {S, aers:isr, _}, {S, aers:indi_pt, Term} <=> id_to_uri(DrugSeq, aers_d, D), {D, aers:indication, Term}. code_to_uri(_, V, V) :- var(V), !. code_to_uri(followup, 'I', aers:'report/initial') :- !. code_to_uri(followup, 'F', aers:'report/followup'):- !. code_to_uri(type, 'EXP', aers:'report/expedited') :- !. code_to_uri(type, 'PER', aers:'report/periodic') :- !. code_to_uri(type, 'DIR', aers:'report/direct') :- !. code_to_uri(reporter, 'MD', aers:'reporter/physician') :- !. code_to_uri(reporter, 'PH', aers:'reporter/pharmacist') :- !. code_to_uri(reporter, 'OT', aers:'reporter/health_professional') :- !. code_to_uri(reporter, 'LW', aers:'reporter/lawyer') :- !. code_to_uri(reporter, 'CN', aers:'reporter/consumer') :- !. code_to_uri(gender, 'UNK', aers:'unknown') :- !. code_to_uri(gender, 'M', aers:'gender/male') :- !. code_to_uri(gender, 'F', aers:'gender/female') :- !. code_to_uri(gender, 'NS', aers:'not_specified') :- !. code_to_uri(weight, 'KG', aers:'weight/kg') :- !. code_to_uri(weight, 'LBS', aers:'weight/lbs') :- !. code_to_uri(weight, 'GMS', aers:'weight/gms') :- !. code_to_uri(age, 'Dec', aers:'duration/decade') :- !. code_to_uri(age, 'YR', aers:'duration/year') :- !. code_to_uri(age, 'MON', aers:'duration/month') :- !. code_to_uri(age, 'WK', aers:'duration/week') :- !. code_to_uri(age, 'DY', aers:'duration/day') :- !. code_to_uri(age, 'HR', aers:'duration/hour') :- !. code_to_uri(role, 'PS', aers:'drug/primary_suspect') :- !. code_to_uri(role, 'SS', aers:'drug/secondary_suspect') :- !. code_to_uri(role, 'C', aers:'drug/concomitant') :- !. code_to_uri(role, 'I', aers:'drug/interacting') :- !. code_to_uri(name_type, '1', aers:'drug/tradename') :- !. code_to_uri(name_type, '2', aers:'drug/verbatim') :- !. code_to_uri(chal, 'Y', aers:'drug/positive') :- !. code_to_uri(chal, 'N', aers:'drug/negative') :- !. code_to_uri(chal, 'U', aers:'drug/unknown') :- !. code_to_uri(chal, 'D', aers:'drug/does_not_apply') :- !. code_to_uri(outcome, 'DE', aers:'outcome/death') :- !. code_to_uri(outcome, 'LT', aers:'outcome/life_threatening') :- !. code_to_uri(outcome, 'HO', aers:'outcome/hospitalization') :- !. code_to_uri(outcome, 'DS', aers:'outcome/disability') :- !. code_to_uri(outcome, 'CA', aers:'outcome/congenital_anomaly') :- !. code_to_uri(outcome, 'RI', aers:'outcome/required_intervention') :- !. code_to_uri(outcome, 'OT', aers:'outcome/other') :- !. code_to_uri(source, 'FGN', aers:'source/foreign') :- !. code_to_uri(source, 'SDY', aers:'source/study') :- !. code_to_uri(source, 'LIT', aers:'source/literature') :- !. code_to_uri(source, 'CSM', aers:'source/consumer') :- !. code_to_uri(source, 'HP', aers:'source/health_professional') :- !. code_to_uri(source, 'UF', aers:'source/user_facility') :- !. code_to_uri(source, 'CR', aers:'source/company_representative') :- !. code_to_uri(source, 'DT', aers:'source/distributor') :- !. code_to_uri(source, 'OTH', aers:'other') :- !. code_to_uri(_, Code, literal(Code)). id_to_uri(Id, NS, URI) :- rdf_current_ns(NS, Prefix), atom_concat(Prefix, Id, URI). at_least_one_given(Values) :- member(V, Values), ground(V), !.