GMRAOR6 ;HIRMFO/WAA-OERR HL7 UTILITY ;10/15/04 10:59
;;4.0;Adverse Reaction Tracking;**17,21**;Mar 29, 1996
; File all allergies Sign/Symptoms
; INPUT
; IEN = The internal entry number for the file entry being modified
; FILE = The file number of the file being modified
; GMRAL = The internal entry number of the GMRAL array being added
;
SIGN(GMRAFILE,GMRAIEN,GMRAL) ; Signs/Symptoms
Q:$G(GMRAIEN)<1
S GMRANODE=$S(GMRAFILE=120.8:10,GMRAFILE=120.85:2,1:0) Q:'GMRANODE
S GMRASN=0 F S GMRASN=$O(GMRAL(GMRAL,"S",GMRASN)) Q:GMRASN<1 D
.Q:$P(GMRAL(GMRAL,"S",GMRASN),U)'>0 ;17 Screen out bad entries
.Q:$O(^GMR(GMRAFILE,GMRAIEN,GMRANODE,"B",$P(GMRAL(GMRAL,"S",GMRASN),U),"")) ;Prevent DUPS
.K DD,DO,DIC,DINUM,DLAYGO
.S DA(1)=GMRAIEN,DIC="^GMR("_GMRAFILE_","_DA(1)_","_GMRANODE_","
.S DIC(0)="L",X=$P(GMRAL(GMRAL,"S",GMRASN),U),DLAYGO=GMRAFILE
.S DIC("P")=$S(GMRANODE=10:"120.81P",1:"120.8502P")
.D FILE^DICN
.K DD,DO,DIC,DINUM,DLAYGO
.S GMRASN=$P(+Y,U)
.S GMRALN=^GMR(GMRAFILE,GMRAIEN,GMRANODE,GMRASN,0) Q:GMRALN=""
.I '$D(GMRAOTH) S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
.S $P(GMRALN,U,3)=$P(GMRAL(GMRAL),U,7)
.I $P(GMRALN,U)=GMRAOTH S $P(GMRALN,U,2)=$P(GMRAL(GMRAL,"S",GMRASN),U,2) ;21
.I GMRANODE=10 S $P(GMRALN,U,4)=$P(GMRAL(GMRAL,"S",GMRASN),U,4)
.S ^GMR(GMRAFILE,GMRAIEN,GMRANODE,GMRASN,0)=GMRALN
.Q
K GMRAIEN,GMRANODE,GMRAFILE,GMRASN,GMRALN,GMRAOTH,Y,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR6 1437 printed Dec 13, 2024@01:39:43 Page 2
GMRAOR6 ;HIRMFO/WAA-OERR HL7 UTILITY ;10/15/04 10:59
+1 ;;4.0;Adverse Reaction Tracking;**17,21**;Mar 29, 1996
+2 ; File all allergies Sign/Symptoms
+3 ; INPUT
+4 ; IEN = The internal entry number for the file entry being modified
+5 ; FILE = The file number of the file being modified
+6 ; GMRAL = The internal entry number of the GMRAL array being added
+7 ;
SIGN(GMRAFILE,GMRAIEN,GMRAL) ; Signs/Symptoms
+1 if $GET(GMRAIEN)<1
QUIT
+2 SET GMRANODE=$SELECT(GMRAFILE=120.8:10,GMRAFILE=120.85:2,1:0)
if 'GMRANODE
QUIT
+3 SET GMRASN=0
FOR
SET GMRASN=$ORDER(GMRAL(GMRAL,"S",GMRASN))
if GMRASN<1
QUIT
Begin DoDot:1
+4 ;17 Screen out bad entries
if $PIECE(GMRAL(GMRAL,"S",GMRASN),U)'>0
QUIT
+5 ;Prevent DUPS
if $ORDER(^GMR(GMRAFILE,GMRAIEN,GMRANODE,"B",$PIECE(GMRAL(GMRAL,"S",GMRASN),U),""))
QUIT
+6 KILL DD,DO,DIC,DINUM,DLAYGO
+7 SET DA(1)=GMRAIEN
SET DIC="^GMR("_GMRAFILE_","_DA(1)_","_GMRANODE_","
+8 SET DIC(0)="L"
SET X=$PIECE(GMRAL(GMRAL,"S",GMRASN),U)
SET DLAYGO=GMRAFILE
+9 SET DIC("P")=$SELECT(GMRANODE=10:"120.81P",1:"120.8502P")
+10 DO FILE^DICN
+11 KILL DD,DO,DIC,DINUM,DLAYGO
+12 SET GMRASN=$PIECE(+Y,U)
+13 SET GMRALN=^GMR(GMRAFILE,GMRAIEN,GMRANODE,GMRASN,0)
if GMRALN=""
QUIT
+14 IF '$DATA(GMRAOTH)
SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+15 SET $PIECE(GMRALN,U,3)=$PIECE(GMRAL(GMRAL),U,7)
+16 ;21
IF $PIECE(GMRALN,U)=GMRAOTH
SET $PIECE(GMRALN,U,2)=$PIECE(GMRAL(GMRAL,"S",GMRASN),U,2)
+17 IF GMRANODE=10
SET $PIECE(GMRALN,U,4)=$PIECE(GMRAL(GMRAL,"S",GMRASN),U,4)
+18 SET ^GMR(GMRAFILE,GMRAIEN,GMRANODE,GMRASN,0)=GMRALN
+19 QUIT
End DoDot:1
+20 KILL GMRAIEN,GMRANODE,GMRAFILE,GMRASN,GMRALN,GMRAOTH,Y,X
+21 QUIT
