| 1 | ALPBHL1U ;OIFO-DALLAS MW,SED,KC -HL7 MESSAGE SEGMENT PARSER AND UPDATE;01/01/03
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**7**;May 2002
|
|---|
| 3 | ;
|
|---|
| 4 | ; passed parameters common to all functions:
|
|---|
| 5 | ; IEN = patient's internal entry number in file 53.7
|
|---|
| 6 | ; OIEN = the order number's internal entry number in file 53.7
|
|---|
| 7 | ; DATA = the HL7 message line
|
|---|
| 8 | ; FS = the HL7 field separator character (e.g., "|" or "^")
|
|---|
| 9 | ; CS = the HL7 component separator character (e.g., "~")
|
|---|
| 10 | ; ECH = the HL7 encoding characters
|
|---|
| 11 | ; ERR = an array passed by reference, returned containing
|
|---|
| 12 | ; FileMan DBS call error array (if any)
|
|---|
| 13 | ;
|
|---|
| 14 | AL1(IEN,DATA,FS,CS,ERR) ; process AL1 (allergies) segment...
|
|---|
| 15 | I +$G(IEN)'>0!($G(DATA)="")!($G(FS)="")!($G(CS)="") D ERRBLD^ALPBUTL1("AL1","",.ERR) Q
|
|---|
| 16 | N ALPBALG,ALPBALGN,ALPBFILE,ALPBNEXT
|
|---|
| 17 | S ALPBALG=+$P(DATA,FS,4)
|
|---|
| 18 | I ALPBALG'>0 D ERRBLD^ALPBUTL1("AL1","Undefined allergy "_DATA,.ERR) Q
|
|---|
| 19 | S ALPBALGN=$P($P(DATA,FS,4),CS,2)
|
|---|
| 20 | ; is this allergy already on file for this patient?...
|
|---|
| 21 | I $D(^ALPB(53.7,IEN,1,"B",ALPBALG)) S ERR("DIERR")=0 Q
|
|---|
| 22 | ; if not, file it...
|
|---|
| 23 | S ALPBNEXT=+$O(^ALPB(53.7,IEN,1," "),-1)+1
|
|---|
| 24 | S ALPBFILE(53.701,"+"_ALPBNEXT_","_IEN_",",.01)=ALPBALG
|
|---|
| 25 | S ALPBFILE(53.701,"+"_ALPBNEXT_","_IEN_",",1)=ALPBALGN
|
|---|
| 26 | D UPDATE^DIE("","ALPBFILE","ALPBNEXT","ERR")
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | ORC(IEN,OIEN,DATA,MLOG,FS,CS,ERR) ; process ORC (common order) segment...
|
|---|
| 30 | ; MLOG = if 1 then this is an ORC segment with a Med Log update
|
|---|
| 31 | ; if 0 then this is a common order update
|
|---|
| 32 | I +$G(IEN)'>0!(+$G(OIEN)'>0)!($G(DATA)="")!($G(MLOG)="")!($G(FS)="")!($G(CS)="") D ERRBLD^ALPBUTL1("ORC","",.ERR) Q
|
|---|
| 33 | N ALPBFIEN,ALPBFILE,ALPBMREC,ALPBNEXT,ALPBTEXT,ALPBX
|
|---|
| 34 | S ALPBFIEN=OIEN_","_IEN_","
|
|---|
| 35 | ; ORC segment with NO MedLog data...
|
|---|
| 36 | I +MLOG=0 D
|
|---|
| 37 | .S ALPBX=$P(DATA,FS,1)
|
|---|
| 38 | .; order status...
|
|---|
| 39 | .S ALPBFILE(53.702,ALPBFIEN,2)=$P(DATA,FS,6)
|
|---|
| 40 | .; provider...
|
|---|
| 41 | .S ALPBFILE(53.702,ALPBFIEN,5)=$P($P(DATA,FS,13),CS,2)
|
|---|
| 42 | .; entry person/rph...
|
|---|
| 43 | .S ALPBFILE(53.702,ALPBFIEN,5.1)=$P($P(DATA,FS,11),CS,2)
|
|---|
| 44 | .; verified by...
|
|---|
| 45 | .S ALPBFILE(53.702,ALPBFIEN,5.2)=$P($P(DATA,FS,12),CS,2)
|
|---|
| 46 | .D UPDATE^DIE("","ALPBFILE","","ERR")
|
|---|
| 47 | .; if this is a pending order, add special instructions...
|
|---|
| 48 | .I $P($P(DATA,FS,6),CS,1)="IP" D
|
|---|
| 49 | ..S ALPBTEXT(1)="CAUTION! THIS IS A PENDING ORDER :: CHECK WITH PROVIDER OR PHARMACIST!"
|
|---|
| 50 | ..D WP^DIE(53.702,ALPBFIEN,8,"A","ALPBTEXT","ERR")
|
|---|
| 51 | ..K ALPBTEXT
|
|---|
| 52 | ; ORC segment with specific MedLog data...
|
|---|
| 53 | I +MLOG=1 D
|
|---|
| 54 | .; ALPBX = med log date/time...
|
|---|
| 55 | .S ALPBX=$$FMDATE^HLFNC($P(DATA,FS,10))
|
|---|
| 56 | .I ALPBX="" K ALPBX Q
|
|---|
| 57 | .; ALPBMREC = med log record number...
|
|---|
| 58 | .S ALPBMREC=+$P($P(DATA,FS,3),CS,1)
|
|---|
| 59 | .; if the med log entry is already on file, update and quit.
|
|---|
| 60 | .; check for both an entry on file for the log date/time ("B" xref)
|
|---|
| 61 | .; or med log record number ("C" xref)...
|
|---|
| 62 | .S ALPBNEXT=+$O(^ALPB(53.7,IEN,2,OIEN,10,"B",ALPBX,""))
|
|---|
| 63 | .I ALPBNEXT'>0 S ALPBNEXT=+$O(^ALPB(53.7,IEN,2,OIEN,10,"C",ALPBMREC,""))
|
|---|
| 64 | .I ALPBNEXT>0 D Q
|
|---|
| 65 | ..S ALPBFILE(53.70213,ALPBNEXT_","_ALPBFIEN,.01)=ALPBX
|
|---|
| 66 | ..S ALPBFILE(53.70213,ALPBNEXT_","_ALPBFIEN,1)=$P($P(DATA,FS,11),CS,2)
|
|---|
| 67 | ..S ALPBFILE(53.70213,ALPBNEXT_","_ALPBFIEN,2)=$P($P(DATA,FS,6),CS,2)
|
|---|
| 68 | ..I ALPBMREC>0 S ALPBFILE(53.70213,ALPBNEXT_","_ALPBFIEN,3)=ALPBMREC
|
|---|
| 69 | ..D UPDATE^DIE("","ALPBFILE","","ERR")
|
|---|
| 70 | .K ALPBNEXT
|
|---|
| 71 | .; if not, add it...
|
|---|
| 72 | .S ALPBNEXT=+$O(^ALPB(53.7,IEN,2,OIEN,6," "),-1)+1
|
|---|
| 73 | .S ALPBFILE(53.70213,"+"_ALPBNEXT_","_ALPBFIEN,.01)=ALPBX
|
|---|
| 74 | .; med log entry person...
|
|---|
| 75 | .S ALPBFILE(53.70213,"+"_ALPBNEXT_","_ALPBFIEN,1)=$P($P(DATA,FS,11),CS,2)
|
|---|
| 76 | .; med log transaction message...
|
|---|
| 77 | .S ALPBFILE(53.70213,"+"_ALPBNEXT_","_ALPBFIEN,2)=$P($P(DATA,FS,6),CS,2)
|
|---|
| 78 | .; med log record number...
|
|---|
| 79 | .I ALPBMREC>0 S ALPBFILE(53.70213,"+"_ALPBNEXT_","_ALPBFIEN,3)=ALPBMREC
|
|---|
| 80 | .D UPDATE^DIE("","ALPBFILE","ALPBNEXT","ERR")
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | PV1(IEN,DATA,FS,CS,ERR) ; process PV1 (patient visit/movement) segment...
|
|---|
| 84 | I +$G(IEN)=0!($G(DATA)="") D ERRBLD^ALPBUTL1("PV1","",.ERR) Q
|
|---|
| 85 | N ALPBFIEN,ALPBFILE,ALPBX
|
|---|
| 86 | S ALPBFIEN=IEN_","
|
|---|
| 87 | S ALPBX=$P(DATA,FS,4)
|
|---|
| 88 | ; ward...
|
|---|
| 89 | S ALPBFILE(53.7,ALPBFIEN,4)=$P(ALPBX,CS)
|
|---|
| 90 | ; room...
|
|---|
| 91 | S ALPBFILE(53.7,ALPBFIEN,5)=$P(ALPBX,CS,2)
|
|---|
| 92 | ; bed...
|
|---|
| 93 | S ALPBFILE(53.7,ALPBFIEN,6)=$P(ALPBX,CS,3)
|
|---|
| 94 | D FILE^DIE("","ALPBFILE","ERR")
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | RXO(IEN,OIEN,DATA,FS,CS,ERR) ; process RXO (pharmacy prescription order) segment...
|
|---|
| 98 | ; for inpatient meds, this segment contains an orderable item. this
|
|---|
| 99 | ; module is ONLY called if the order is "P"ending. it only files the
|
|---|
| 100 | ; orderable item if no drug is on file for the order.
|
|---|
| 101 | N ALPBDIEN,ALPBDRUG,ALPBFILE,ALPBNEXT
|
|---|
| 102 | I +$G(IEN)'>0!(+$G(OIEN)'>0)!($G(DATA)="")!($G(FS)="")!($G(CS)="") D ERRBLD^ALPBUTL1("RXO","",.ERR) Q
|
|---|
| 103 | S ALPBDIEN=+$P($P(DATA,FS,2),CS,4)
|
|---|
| 104 | S ALPBDRUG=$P($P(DATA,FS,2),CS,5)
|
|---|
| 105 | I ALPBDIEN'>0 D ERRBLD^ALPBUTL1("RXO","Invalid drug IEN in RXO segment",.ERR) Q
|
|---|
| 106 | ; if there is ANY drug already on file, quit...
|
|---|
| 107 | I +$O(^ALPB(53.7,IEN,2,OIEN,7,0))>0 Q
|
|---|
| 108 | ; if not, file it...
|
|---|
| 109 | S ALPBNEXT=+$O(^ALPB(53.7,IEN,2,OIEN,7," "),-1)+1
|
|---|
| 110 | S ALPBFILE(53.703,"+"_ALPBNEXT_","_OIEN_","_IEN_",",.01)=ALPBDIEN
|
|---|
| 111 | S ALPBFILE(53.703,"+"_ALPBNEXT_","_OIEN_","_IEN_",",1)=ALPBDRUG
|
|---|
| 112 | D UPDATE^DIE("","ALPBFILE","ALPBNEXT","ERR")
|
|---|
| 113 | Q
|
|---|
| 114 | ;
|
|---|
| 115 | RXE(IEN,OIEN,DATA,FS,CS,ECH,ERR) ; process RXE (order detail) segment...
|
|---|
| 116 | ; this segment may contain the drug name, though there may not be a drug
|
|---|
| 117 | ; because this can also be used for order detail for IV's which are
|
|---|
| 118 | ; contained in an RXC segment. this segment can also contain start/stop
|
|---|
| 119 | ; date&time, dosage and schedule
|
|---|
| 120 | I +$G(IEN)'>0!(+$G(OIEN)'>0)!($G(DATA)="")!($G(FS)="")!($G(CS)="")!($G(ECH)="") D ERRBLD^ALPBUTL1("RXE","",.ERR) Q
|
|---|
| 121 | N ALPBDIEN,ALPBDRUG,ALPBFIEN,ALPBFILE,ALPBNEXT,ALPBSCHD,ALPBX,SCS
|
|---|
| 122 | S SCS=$E(ECH,4)
|
|---|
| 123 | S ALPBFIEN=OIEN_","_IEN_","
|
|---|
| 124 | ; for drug, we'll use the one that came from the Drug file...
|
|---|
| 125 | S ALPBDIEN=+$P($P(DATA,FS,3),CS,4)
|
|---|
| 126 | S ALPBDRUG=$P($P(DATA,FS,3),CS,5)
|
|---|
| 127 | ; is this drug already on file for this order? if not, add it...
|
|---|
| 128 | I ALPBDIEN>0&('$D(^ALPB(53.7,IEN,2,OIEN,7,"B",ALPBDIEN))) D
|
|---|
| 129 | .S ALPBNEXT=+$O(^ALPB(53.7,IEN,2,OIEN,7," "),-1)+1
|
|---|
| 130 | .S ALPBFILE(53.703,"+"_ALPBNEXT_","_ALPBFIEN,.01)=ALPBDIEN
|
|---|
| 131 | .S ALPBFILE(53.703,"+"_ALPBNEXT_","_ALPBFIEN,1)=ALPBDRUG
|
|---|
| 132 | .D UPDATE^DIE("","ALPBFILE","ALPBNEXT","ERR")
|
|---|
| 133 | .K ALPBFERR,ALPBFILE,ALPBNEXT
|
|---|
| 134 | S ALPBX=$P(DATA,FS,2)
|
|---|
| 135 | ; start date/time...
|
|---|
| 136 | S ALPBFILE(53.702,ALPBFIEN,4)=$$FMDATE^HLFNC($P(ALPBX,CS,4))
|
|---|
| 137 | ; stop date/time...
|
|---|
| 138 | S ALPBFILE(53.702,ALPBFIEN,4.1)=$$FMDATE^HLFNC($P(ALPBX,CS,5))
|
|---|
| 139 | ; dosage...
|
|---|
| 140 | S ALPBFILE(53.702,ALPBFIEN,7)=$P(ALPBX,CS,8)
|
|---|
| 141 | ; schedule...
|
|---|
| 142 | S ALPBSCHD=$P(ALPBX,CS,2)
|
|---|
| 143 | I $P(DATA,FS,24)'="" S ALPBSCHD=ALPBSCHD_" "_$P(DATA,FS,24)
|
|---|
| 144 | I $P($P(DATA,FS,25),CS,5)'="" S ALPBSCHD=ALPBSCHD_" "_$P($P(DATA,FS,25),CS,5)
|
|---|
| 145 | S ALPBFILE(53.702,ALPBFIEN,7.2)=ALPBSCHD
|
|---|
| 146 | ; timing...
|
|---|
| 147 | S ALPBFILE(53.702,ALPBFIEN,7.3)=$P($P(DATA,FS,22),CS,2)
|
|---|
| 148 | D UPDATE^DIE("","ALPBFILE","","ERR")
|
|---|
| 149 | Q
|
|---|
| 150 | ;
|
|---|
| 151 | RXR(IEN,OIEN,DATA,FS,CS,ERR) ; process RXR (med administration route) segment...
|
|---|
| 152 | I +$G(IEN)'>0!(+$G(OIEN)'>0)!($G(DATA)="")!($G(FS)="")!($G(CS)="") D ERRBLD^ALPBUTL1("RXR","",.ERR) Q
|
|---|
| 153 | N ALPBFILE
|
|---|
| 154 | ; route...
|
|---|
| 155 | S ALPBFILE(53.702,OIEN_","_IEN_",",7.1)=$P($P(DATA,FS,2),CS,5)
|
|---|
| 156 | D UPDATE^DIE("","ALPBFILE","","ERR")
|
|---|
| 157 | Q
|
|---|
| 158 | ;
|
|---|
| 159 | RXC(IEN,OIEN,DATA,FS,CS,ERR) ; process RXC (IV orders: additives/solutions) segment...
|
|---|
| 160 | I +$G(IEN)'>0!(+$G(OIEN)'>0)!($G(DATA)="")!($G(FS)="")!($G(CS)="") D ERRBLD^ALPBUTL1("RXC","",.ERR) Q
|
|---|
| 161 | N ALPBFILE,ALPBFNOD,ALPBGNOD,ALPBNAM,ALPBNEXT,ALPBNUM,ALPBTYP,ALPBUNIT
|
|---|
| 162 | S ALPBTYP=$P(DATA,FS,2)
|
|---|
| 163 | S ALPBGNOD=$S(ALPBTYP="A":8,ALPBTYP="B":9,1:0)
|
|---|
| 164 | I ALPBGNOD=0 D ERRBLD^ALPBUTL1("RXC","Unable to determine Additive or Solution in RXC segment",.ERR) Q
|
|---|
| 165 | S ALPBFNOD="53.7021"_$S(ALPBGNOD=8:1,1:2)
|
|---|
| 166 | S ALPBNUM=$P($P(DATA,FS,3),CS,4)
|
|---|
| 167 | ; is this additive or solution already on file?...
|
|---|
| 168 | I $D(^ALPB(53.7,IEN,2,OIEN,ALPBGNOD,"B",ALPBNUM)) S ERR("DIERR")=0 Q
|
|---|
| 169 | ; if not, file it...
|
|---|
| 170 | S ALPBNAM=$P($P(DATA,FS,3),CS,5)
|
|---|
| 171 | S ALPBUNIT=$P(DATA,FS,4)_$P($P(DATA,FS,5),CS,5)
|
|---|
| 172 | S ALPBNEXT=+$O(^ALPB(53.7,IEN,2,OIEN,ALPBGNOD," "),-1)+1
|
|---|
| 173 | S ALPBFILE(ALPBFNOD,"+"_ALPBNEXT_","_OIEN_","_IEN_",",.01)=ALPBNUM
|
|---|
| 174 | S ALPBFILE(ALPBFNOD,"+"_ALPBNEXT_","_OIEN_","_IEN_",",1)=ALPBNAM
|
|---|
| 175 | S ALPBFILE(ALPBFNOD,"+"_ALPBNEXT_","_OIEN_","_IEN_",",2)=ALPBUNIT
|
|---|
| 176 | D UPDATE^DIE("","ALPBFILE","ALPBNEXT","ERR")
|
|---|
| 177 | Q
|
|---|
| 178 | ;
|
|---|
| 179 | NTE(IEN,OIEN,DATA,FS,CS,ERR) ; process NTE (note) segment...
|
|---|
| 180 | ; note: in the case of NTE segments, DATA is passed in as an array.
|
|---|
| 181 | ; NTE data can be in multiple nodes, the first subscript of which
|
|---|
| 182 | ; contains the actual NTE segments itself.
|
|---|
| 183 | I +$G(IEN)'>0!(+$G(OIEN)'>0)!($D(DATA)=0)!($G(FS)="")!($G(CS)="") D ERRBLD^ALPBUTL1("NTE","",.ERR) Q
|
|---|
| 184 | N ALPBFILE,I
|
|---|
| 185 | ; check the status of this order. if it is pending, abort
|
|---|
| 186 | ; and do not file any special comments (note ORC module comments)...
|
|---|
| 187 | I $E($P($G(^ALPB(53.7,IEN,2,OIEN,0)),"^",3),1,2)="IP" Q
|
|---|
| 188 | ; examine DATA(1) and from the Pharmacy package code in the second
|
|---|
| 189 | ; field, insert a header at the first subscript level of our working
|
|---|
| 190 | ; array (which we will pass to the FileMan call)...
|
|---|
| 191 | S ALPBFILE(1)=$S($P(DATA(1),FS,2)=6:"Provider Comments:",$P(DATA(1),FS,2)=21:"Special Instructions:",1:"Other Info:")
|
|---|
| 192 | ; now get the data from DATA(1), field 4 and set it into the second subscript of our
|
|---|
| 193 | ; working array...
|
|---|
| 194 | S ALPBFILE(2)=$P(DATA(1),FS,4)
|
|---|
| 195 | ; finally, process the rest of the lines from the DATA(n) array into our working array...
|
|---|
| 196 | S I=2
|
|---|
| 197 | F S I=$O(DATA(I)) Q:'I S ALPBFILE(I)=DATA(I)
|
|---|
| 198 | D WP^DIE(53.702,OIEN_","_IEN_",",8,"","ALPBFILE","ERR")
|
|---|
| 199 | Q
|
|---|
