/* * Copyright (c) 1995, 1996 Gunther Schadow. All rights reserved. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ % Clauses which clean up the HL-7 database. % % main entry point is cleanup/0 % :- module(db_clean,[cleanup/0]). :- style_check(+string). :- use_module(db-check,[removeNoKey/0,undefdSeg/1,undefdMsg/1,retractNotify/1,univalue/4]). :- use_module(db-inter,[nil/1,nonnil/1,unimesg/3,unidesc/3]). val_number_stack(999999). new_val_number(Vn) :- val_number_stack(Vn), NVn is Vn - 1, retract(val_number_stack(Vn)), assert(val_number_stack(NVn)). cleanup :- use_module(rhl7), removeNoKey, fixAbstractSyntax, fix2_1, fixRepOpt, tell(hl7), forall(functional_area(Id, Chp, Des), writef("%t.\n", [functional_area(Id, Chp, Des)])), nl, undefdSeg(UDSMs), forall(member([msg(M,E,D,B),_],UDSMs), ( message(M,E,D,B) -> retractNotify(rdb:message(M,E,D,B)) ; true )), undefdMsg(UDMSs), forall(member(M,UDMSs), forall(rdb:value(0076,M,A1,A2,A3), retractNotify(rdb:value(0076,M,A1,A2,A3)))), /* A composite data_type for the Message ID field in the MSH */ rdb:field(msh, 9, MSH91, _, MSH93, MSH94, MSH95, MSH96, MSH97, MSH98), retractall(rdb:field(msh, 9, _, _, _, _, _, _, _, _)), assert(rdb:field(msh,9, MSH91,zm, MSH93, MSH94, MSH95, MSH96, MSH97, MSH98)), assert(rdb:data_type(zm, "message id and event code", '')), /* A composite data_type for the Patient Location in * PV1: 3, 6, 11, 43 * NPU: 1 */ forall( member([Seg, Nr], [[pv1,3], [pv1,6], [pv1,11], [pv1,43], [npu,1]]), ( rdb:field(Seg, Nr, F3, _, F5, F6, F7, F8, F9, F10), retractall(rdb:field(Seg, Nr, _, _, _, _, _, _, _, _)), assert(rdb:field(Seg, Nr, F3, zl, F5, F6, F7, F8, F9, F10)) )), assert(rdb:data_type(zl, "patient location", '')), /* * The `error code and location' field in the ERR segment is defined to * be an ID segment with four components, which is a contradiction. So * I change the ID to ZE, which is defined in the file `composite.pl'. * The `forall' keeps the F-Variables local. */ assert(rdb:data_type(ze, "error code and location", '')), forall(rdb:field(err, 1, F3, _, F5, F6, F7, F8, F9, F10), ( retractall(rdb:field(err, 1, _, _, _, _, _, _, _, _)), assert(rdb:field(err, 1, F3, ze, F5, F6, F7, F8, F9, F10)) )), /* add missing message types to message_type * we have no use for undef'd messages */ forall(rdb:message(Mt,_,Ds,_), (( rdb:value(76,Mt,D,Fa,_) -> writef("%t.\n", [message_type(Mt,D,Fa)]) ; ( writef("%t.\n", [message_type(Mt,Ds,'')]), new_val_number(Vn), assert(rdb:value(76,Mt,Ds,'',Vn)))))), forall(message(Id, Ec, Des, Def), writef("%t.\n", [message(Id, Ec, Des, Def)])), nl, forall(segment(Id, Des, Fa), writef("%t.\n", [segment(Id, Des, Fa)])), nl, forall(field(S,F,L,Dt,Ro,Rp,Tb1,De,Ds,_), ( ( univalue(Tb1,_,_,_) -> Tb = Tb1; Tb = Tb1 % yes, keep the table number for later use ), portray_clause((field(S,F,Ds,Dt,Tb,Ro,Rp,L,De) :- true) ))), forall(data_type(Id, Des, Len), writef("%t.\n", [data_type(Id, Des, Len)])), nl, forall((table(Id, Des, Cl), univalue(Id,_,_,_)), writef("%t.\n", [table(Id, Des, Cl)])), nl, writef("%t.\n", [table(9997,"unique message id",derived)]), writef("%t.\n", [table(9998,"data type",derived)]), writef("%t.\n", [table(9999,"segment type",derived)]), nl, forall(univalue(Tb, Id, Des, Vn), writef("%t.\n", [value(Tb, Id, Des, Vn)])), nl, forall(message(Vm,Ve,D,_), ( unimesg(Vm,Ve,V), unidesc(D,Ve,Du), writef("%t.\n", [value(9997,V,Du,_)]))), forall(data_type(V,D,_), writef("%t.\n", [value(9998,V,D,_)])), forall(segment(V,D,_), writef("%t.\n", [value(9999,V,D,_)])), nl, told. special_segment(msh). special_segment(fhs). special_segment(bhs). fixAbstractSyntax :- /* * Eliminate encoding rules related stuff from the definitions */ forall((special_segment(Seg), member(Fld, [1,2]), rdb:field(Seg,Fld,Len,Dt,Ro,Rp,Tb,De,Ds,Dsd)), retract(rdb:field(Seg,Fld,Len,Dt,Ro,Rp,Tb,De,Ds,Dsd))). fix2_1 :- /* * Correct the names of acknowledgements: make them uniqe. */ forall(rdb:message(ack, E, D, B), retract(rdb:message(ack, E, D, B))), assert(rdb:message(ack, '', "general acknowledgement", [msh,msa,opt(err)])), forall(rdb:message(mcf, E, D, B), retract(rdb:message(mcf, E, D, B))), assert(rdb:message(mcf, '', "deferred acknowledgement", [msh,msa,opt(err)])), /* * In Query messages, event codes are not reflected into an EVN * segment. In fact, there is no polymorphism. Different event codes * in QRYmsg stand for different semantics, which is reflected in * detail in one of their fields. So there is no need for an explicit * event code here. * DSRmsg is found with event code and without in the document, since * we ignore event codes for messages without EVNseg, we just keep the * definition without event code. */ forall(rdb:message(dsr, q03, D, B), retract(rdb:message(dsr, q03, D, B))), forall(rdb:message(qry, E, D, B), retract(rdb:message(qry, E, D, B))), assert(rdb:message(qry, '', "query", [msh, qrd, opt(qrf), opt(dsc)])), /* * DFTmsg is a EVNseg selected message, so we have to keep the event code! * forall(rdb:message(dft, E, D, B), ( retract(rdb:message(dft, E, D, B)), assert(rdb:message(dft, '', D, B)))), */ /* * Fix the ORM message that was screwed up due to a missing closing * bracket */ forall(rdb:message(orm, E, D, B), retract(rdb:message(orm, E, D, B))), assert(rdb:message(orm, '', "order message", [msh,opt(rep(nte)), opt(pid, opt(rep(nte)), opt(pv1)), rep(orc, opt(any(obr,oro,rx1)), opt(rep(nte)), opt(rep(obx), opt(rep(nte))), opt(blg))])), /* * Just to complete the any(...) term. */ forall(rdb:message(orr, E, D, B), retract(rdb:message(orr, E, D, B))), assert(rdb:message(orr, '', "order response", [msh,msa, opt(rep(nte)), opt(opt(pid), opt(rep(nte)), rep(orc, any(obr,oro,rx1), opt(rep(nte))))])), /* * There is one closing brace too much. */ forall(rdb:message(orf, E, D, B), retract(rdb:message(orf, E, D, B))), assert(rdb:message(orf, '', "observational report", [msh,msa, rep(qrd, opt(qrf), opt(pid), opt(rep(nte)), rep(opt(orc), obr, rep(opt(nte)), opt(rep(obx), opt(rep(nte))))), opt(dsc)])), /* * In the ORU message, there is a group rep(opt(obx), rep(opt(nte))) * results in an infinite parsing of the outer repetition. * Fix: opt(obx) -> obx * (how can these fixes be made automatically?) */ forall(rdb:message(oru, E, D, B), retract(rdb:message(oru, E, D, B))), assert(rdb:message(oru,'',"observational results (unsolicited)", [msh, msa, rep(opt(pid, opt(rep(nte)), opt(pv1)), rep(opt(orc), obr, rep(opt(nte)), opt(rep(obx), rep(opt(nte))))), opt(dsc)])), /* * I bet that the MSA segment in the NMD message is wrong. There is * no use for an MSA in an unsolicited update. I'll make it at least * an optional segment (thus it could match a possible NMQuery). */ forall(rdb:message(nmd, E, D, B), retract(rdb:message(nmd, E, D, B))), assert(rdb:message(nmd, '', "network management data", [msh,opt(msa), rep(opt(nck), opt(rep(nte)), opt(nst), opt(rep(nte)), opt(nsc), opt(rep(nte)))])). /* * The production `rep(opt(X))' is an infinite recursion since it * yields (X.(X.(X.(nil.(nil.(nil.(...))))))). Thus we will change * all of those productions to `opt(rep(X))'. However, the production * rep(opt(X1), opt(X2), opt(X3), ... , opt(Xn)) yields the same * recursion and we can't do anything about it here. The parser has * to manage this problem. */ fixRepOpt :- forall(message(M, E, C, DefL), ( fixRepOpt(DefL, DefLn), retractall(rdb:message(M, E, C, DefL)), assert(fixed_message(M, E, C, DefLn)) )), forall(fixed_message(M, E, C, D), ( retractall(fixed_message(M, E, C, D)), assert(rdb:message(M, E, C, D)) )). fixRepOpt([],[]). fixRepOpt([H|T],[Hn|Tn]) :- fixRepOpt1(H, Hn), fixRepOpt(T, Tn). fixRepOpt1(rep(opt(X)), opt(rep(X))). fixRepOpt1(X, Xn) :- X =.. [F|A], fixRepOpt(A, An), Xn =.. [F|An].