GMRAOR4 ;HIRMFO/WAA,FPT-OERR HL7 UTILITY ; 2/9/95
;;4.0;Adverse Reaction Tracking;**4,16**;Oct 10, 2000
;MSG = HL7 Message array
;GMRANODE = IEN of MSG array
;GMRAND = Date from MSG(GMRANODE)
;GMRAMTP = Message type
EN1(MSG) ; MSG is the array that is passed to ART should be pass by
; reference
N GMRANODE,GMRAND,GMRAMTP
S GMRANODE=0
F S GMRANODE=$O(MSG(GMRANODE)) Q:GMRANODE<1 D
.S GMRAND=MSG(GMRANODE),GMRAMTP=$E(GMRAND,1,3)
.I "^MSH^PID^PV1^AL1^ZAL^ZAO^ZAS^NTE^"'[("^"_GMRAMTP_"^") S GMRAMTP="ERROR"
.D @GMRAMTP
.Q
K %,DL1,DL2,DL3,DL4,DL4,GMRAI,GMRAID,GMRAIDC,GMRAIDN,GMRAIDO,GMRAIDS,I
D EN1^GMRAOR5
K GMRADFN,GMRAL
Q
MSH ;Message Header Information
;Set up delimiters DL1-DL5
N GMRADL
F I=1:1:5 S GMRADL="DL"_I,@GMRADL=$E(GMRAND,(3+I)) ; Assign all delimiters
Q
PID ;Patient Id Information
;GMRADFN = DFN of patient in ^DPT(DFN) Patient (2) file
S GMRADFN=$P(GMRAND,DL1,4)
Q
PV1 ;Allergy Information
Q
AL1 ;Allergy informaton
;building GMRAL Array to be used to stuff only new data
;GMRAID=sequence number of allergy
;~=continuation
; Allergy AL1 Segment
; GMRAL(GMRAID)=type^file ien^VA Free text drug^file^OERR entry date^~
; GMRAL(1)="D^5^SHELL FISH^99ALL^2940415.06^~
; ZAL Segment
; GMRAL(GMRAID)=~NKA Status^Originator Pt to 200^Observed/Historical
; GMRAL(1)=~y^1270^o"
S GMRAID=$P(GMRAND,DL1,2)
S %=$P(GMRAND,DL1,3)
S %=$S(%="DA":"D",%="FA":"F",%="MA":"O",%="MC":"O",%="AT":"DFO","^DF^DO^FO^"["^"_%_"^":%,1:"")
S GMRAL(GMRAID)=%
S %="" F GMRAI=4:1:6 S %=%_U_$P($P(GMRAND,DL1,4),DL2,GMRAI)
S GMRAL(GMRAID)=GMRAL(GMRAID)_%
S %=$$HL7TFM^XLFDT($P(GMRAND,DL1,7))
S GMRAL(GMRAID)=GMRAL(GMRAID)_U_%
Q
ZAL ;Allergy type information
S GMRAL(GMRAID)=GMRAL(GMRAID)_U_$S($P(GMRAND,DL1,3)="YES":"n",$P(GMRAND,DL1,3)="NO":"y",1:"")_U_$P(GMRAND,DL1,4)
S GMRAL(GMRAID)=GMRAL(GMRAID)_U_$S($P(GMRAND,DL1,5)="OB":"o",$P(GMRAND,DL1,5)="HI":"h",1:"")
Q
ZAO ;Observed allergy information
;GMRAIDO = Sequence #
; ZAO Observed reaction section
; GMRAL(GMRAID,"O",GMRAIDO)=Observed date^Severity^Observer's DUZ
; GMRAL(1,"O",1)="2940401.1^3^1234"
;S GMRAIDO=$P(GMRAND,DL1,2)
S GMRAIDO=1
S %=$$HL7TFM^XLFDT($P(GMRAND,DL1,3))
S GMRAL(GMRAID,"O",GMRAIDO)=%
S %=$P(GMRAND,DL1,4)
S GMRAL(GMRAID,"O",GMRAIDO)=GMRAL(GMRAID,"O",GMRAIDO)_U_$S(%="MI":1,%="MO":2,%="SV":3,1:"")_U_$P(GMRAND,DL1,5)
Q
ZAS ;Allergy Signs/Symptoms
;GMRAIDS = Sequence #
; ZAS Observed reaction section
; GMRAL(GMRAID,"S",GMRAIDS)=IEN of file^Free Text of entry^File of SS
; ^Date of the SS
; GMRAL(1,"S",1)="32^SEVERE RASH^99ALS^2951211.1120"
S GMRAIDS=$P(GMRAND,DL1,2)
S GMRAL(GMRAID,"S",GMRAIDS)=$P($P(GMRAND,DL1,3),DL2,4)_U
S GMRAL(GMRAID,"S",GMRAIDS)=GMRAL(GMRAID,"S",GMRAIDS)_$P($P(GMRAND,DL1,3),DL2,5)_U
S GMRAL(GMRAID,"S",GMRAIDS)=GMRAL(GMRAID,"S",GMRAIDS)_$P($P(GMRAND,DL1,3),DL2,6)_U
S %=$P(GMRAND,DL1,4)
I %'="" S %=$$HL7TFM^XLFDT($P(GMRAND,DL1,4)),GMRAL(GMRAID,"S",GMRAIDS)=GMRAL(GMRAID,"S",GMRAIDS)_%
Q
NTE ;Comments
;GMRAIDN = Sequence #
;GMRAIDC = the next line of text from the HL7 script
; NTE Comments section
; GMRAL(GMRAID,"N",GMRAIDN)=Source of comments(Originator always)
; GMRAL(1,"N",1)="n"
; GMRAL(1,"N",1,1)=FREE TEXT
S GMRAIDN=1
; old Code S GMRAIDN=$P(GMRAND,DL1,2)
S GMRAL(GMRAID,"N",GMRAIDN)="O"
; old code S GMRAL(GMRAID,"N",GMRAIDN,1)=$P(GMRAND,DL1,3)
S GMRAL(GMRAID,"N",GMRAIDN,1)=$P(GMRAND,DL1,4)
; old code S GMRAIDC="0" F S GMRAIDC=$O(MSG(GMRANODE,GMRAIDC)) Q:GMRAIDC<1 Q:$P(MSG(GMRANODE,GMRAIDC),DL1)'="NTE" D
S GMRAIDC="0" F S GMRAIDC=$O(MSG(GMRANODE,GMRAIDC)) Q:GMRAIDC<1 D
.S GMRAL(GMRAID,"N",GMRAIDN,GMRAIDC+1)=MSG(GMRANODE,GMRAIDC)
.Q
Q
ERROR ;Error handling
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR4 3796 printed Apr 09, 2024@20:45:52 Page 2
GMRAOR4 ;HIRMFO/WAA,FPT-OERR HL7 UTILITY ; 2/9/95
+1 ;;4.0;Adverse Reaction Tracking;**4,16**;Oct 10, 2000
+2 ;MSG = HL7 Message array
+3 ;GMRANODE = IEN of MSG array
+4 ;GMRAND = Date from MSG(GMRANODE)
+5 ;GMRAMTP = Message type
EN1(MSG) ; MSG is the array that is passed to ART should be pass by
+1 ; reference
+2 NEW GMRANODE,GMRAND,GMRAMTP
+3 SET GMRANODE=0
+4 FOR
SET GMRANODE=$ORDER(MSG(GMRANODE))
if GMRANODE<1
QUIT
Begin DoDot:1
+5 SET GMRAND=MSG(GMRANODE)
SET GMRAMTP=$EXTRACT(GMRAND,1,3)
+6 IF "^MSH^PID^PV1^AL1^ZAL^ZAO^ZAS^NTE^"'[("^"_GMRAMTP_"^")
SET GMRAMTP="ERROR"
+7 DO @GMRAMTP
+8 QUIT
End DoDot:1
+9 KILL %,DL1,DL2,DL3,DL4,DL4,GMRAI,GMRAID,GMRAIDC,GMRAIDN,GMRAIDO,GMRAIDS,I
+10 DO EN1^GMRAOR5
+11 KILL GMRADFN,GMRAL
+12 QUIT
MSH ;Message Header Information
+1 ;Set up delimiters DL1-DL5
+2 NEW GMRADL
+3 ; Assign all delimiters
FOR I=1:1:5
SET GMRADL="DL"_I
SET @GMRADL=$EXTRACT(GMRAND,(3+I))
+4 QUIT
PID ;Patient Id Information
+1 ;GMRADFN = DFN of patient in ^DPT(DFN) Patient (2) file
+2 SET GMRADFN=$PIECE(GMRAND,DL1,4)
+3 QUIT
PV1 ;Allergy Information
+1 QUIT
AL1 ;Allergy informaton
+1 ;building GMRAL Array to be used to stuff only new data
+2 ;GMRAID=sequence number of allergy
+3 ;~=continuation
+4 ; Allergy AL1 Segment
+5 ; GMRAL(GMRAID)=type^file ien^VA Free text drug^file^OERR entry date^~
+6 ; GMRAL(1)="D^5^SHELL FISH^99ALL^2940415.06^~
+7 ; ZAL Segment
+8 ; GMRAL(GMRAID)=~NKA Status^Originator Pt to 200^Observed/Historical
+9 ; GMRAL(1)=~y^1270^o"
+10 SET GMRAID=$PIECE(GMRAND,DL1,2)
+11 SET %=$PIECE(GMRAND,DL1,3)
+12 SET %=$SELECT(%="DA":"D",%="FA":"F",%="MA":"O",%="MC":"O",%="AT":"DFO","^DF^DO^FO^"["^"_%_"^":%,1:"")
+13 SET GMRAL(GMRAID)=%
+14 SET %=""
FOR GMRAI=4:1:6
SET %=%_U_$PIECE($PIECE(GMRAND,DL1,4),DL2,GMRAI)
+15 SET GMRAL(GMRAID)=GMRAL(GMRAID)_%
+16 SET %=$$HL7TFM^XLFDT($PIECE(GMRAND,DL1,7))
+17 SET GMRAL(GMRAID)=GMRAL(GMRAID)_U_%
+18 QUIT
ZAL ;Allergy type information
+1 SET GMRAL(GMRAID)=GMRAL(GMRAID)_U_$SELECT($PIECE(GMRAND,DL1,3)="YES":"n",$PIECE(GMRAND,DL1,3)="NO":"y",1:"")_U_$PIECE(GMRAND,DL1,4)
+2 SET GMRAL(GMRAID)=GMRAL(GMRAID)_U_$SELECT($PIECE(GMRAND,DL1,5)="OB":"o",$PIECE(GMRAND,DL1,5)="HI":"h",1:"")
+3 QUIT
ZAO ;Observed allergy information
+1 ;GMRAIDO = Sequence #
+2 ; ZAO Observed reaction section
+3 ; GMRAL(GMRAID,"O",GMRAIDO)=Observed date^Severity^Observer's DUZ
+4 ; GMRAL(1,"O",1)="2940401.1^3^1234"
+5 ;S GMRAIDO=$P(GMRAND,DL1,2)
+6 SET GMRAIDO=1
+7 SET %=$$HL7TFM^XLFDT($PIECE(GMRAND,DL1,3))
+8 SET GMRAL(GMRAID,"O",GMRAIDO)=%
+9 SET %=$PIECE(GMRAND,DL1,4)
+10 SET GMRAL(GMRAID,"O",GMRAIDO)=GMRAL(GMRAID,"O",GMRAIDO)_U_$SELECT(%="MI":1,%="MO":2,%="SV":3,1:"")_U_$PIECE(GMRAND,DL1,5)
+11 QUIT
ZAS ;Allergy Signs/Symptoms
+1 ;GMRAIDS = Sequence #
+2 ; ZAS Observed reaction section
+3 ; GMRAL(GMRAID,"S",GMRAIDS)=IEN of file^Free Text of entry^File of SS
+4 ; ^Date of the SS
+5 ; GMRAL(1,"S",1)="32^SEVERE RASH^99ALS^2951211.1120"
+6 SET GMRAIDS=$PIECE(GMRAND,DL1,2)
+7 SET GMRAL(GMRAID,"S",GMRAIDS)=$PIECE($PIECE(GMRAND,DL1,3),DL2,4)_U
+8 SET GMRAL(GMRAID,"S",GMRAIDS)=GMRAL(GMRAID,"S",GMRAIDS)_$PIECE($PIECE(GMRAND,DL1,3),DL2,5)_U
+9 SET GMRAL(GMRAID,"S",GMRAIDS)=GMRAL(GMRAID,"S",GMRAIDS)_$PIECE($PIECE(GMRAND,DL1,3),DL2,6)_U
+10 SET %=$PIECE(GMRAND,DL1,4)
+11 IF %'=""
SET %=$$HL7TFM^XLFDT($PIECE(GMRAND,DL1,4))
SET GMRAL(GMRAID,"S",GMRAIDS)=GMRAL(GMRAID,"S",GMRAIDS)_%
+12 QUIT
NTE ;Comments
+1 ;GMRAIDN = Sequence #
+2 ;GMRAIDC = the next line of text from the HL7 script
+3 ; NTE Comments section
+4 ; GMRAL(GMRAID,"N",GMRAIDN)=Source of comments(Originator always)
+5 ; GMRAL(1,"N",1)="n"
+6 ; GMRAL(1,"N",1,1)=FREE TEXT
+7 SET GMRAIDN=1
+8 ; old Code S GMRAIDN=$P(GMRAND,DL1,2)
+9 SET GMRAL(GMRAID,"N",GMRAIDN)="O"
+10 ; old code S GMRAL(GMRAID,"N",GMRAIDN,1)=$P(GMRAND,DL1,3)
+11 SET GMRAL(GMRAID,"N",GMRAIDN,1)=$PIECE(GMRAND,DL1,4)
+12 ; old code S GMRAIDC="0" F S GMRAIDC=$O(MSG(GMRANODE,GMRAIDC)) Q:GMRAIDC<1 Q:$P(MSG(GMRANODE,GMRAIDC),DL1)'="NTE" D
+13 SET GMRAIDC="0"
FOR
SET GMRAIDC=$ORDER(MSG(GMRANODE,GMRAIDC))
if GMRAIDC<1
QUIT
Begin DoDot:1
+14 SET GMRAL(GMRAID,"N",GMRAIDN,GMRAIDC+1)=MSG(GMRANODE,GMRAIDC)
+15 QUIT
End DoDot:1
+16 QUIT
ERROR ;Error handling
+1 QUIT
