GMRAOR7 ;HIRMFO/WAA,FPT-OERR HL7 UTILITY ;8/28/03 13:52
;;4.0;Adverse Reaction Tracking;**4,17**;Mar 29, 1996
ADVERSE(GMRAPA,GMRAL) ;Add a Adverse reaction entry to file 120.85
;INPUT
; GMRAPA = the entry in file 120.8 that was added
; GMRAL = The entry in the GMRAL array that is being added
;
N GMRAO,GMRAPA1,X,Y
S GMRAO=0 F S GMRAO=$O(GMRAL(GMRAL,"O",GMRAO)) Q:GMRAO<1 D
.K DD,DO,DIC,DINUM,DLAYGO
.S DIC="^GMR(120.85,",DLAYGO=120.85,DIC(0)="L",X=$P(GMRAL(GMRAL,"O",GMRAO),U)
.D FILE^DICN
.K DD,DO,DIC,DINUM,DLAYGO
.Q:Y=-1 S GMRAPA1=+Y
.N GMRALN
.F Q:$$LOCK^GMRAUTL(120.85,GMRAPA1)
.S GMRALN=^GMR(120.85,GMRAPA1,0)
.S $P(GMRALN,U,2)=GMRADFN
.S $P(GMRALN,U,13)=$P(GMRAL(GMRAL),U,7)
.I $P(GMRAL(GMRAL,"O",GMRAO),U,3)]"" S $P(GMRALN,U,13)=$P(GMRAL(GMRAL,"O",GMRAO),U,3)
.S $P(GMRALN,U,14)=$P(GMRAL(GMRAL,"O",GMRAO),U,2)
.S $P(GMRALN,U,15)=GMRAPA
.S ^GMR(120.85,GMRAPA1,0)=GMRALN
.I $D(GMRAL(GMRAL,"S",1)) D SIGN^GMRAOR6(120.85,GMRAPA1,.GMRAL) ;S/S
.S ^GMR(120.85,GMRAPA1,3,0)="^120.8503^1^1"
.S ^GMR(120.85,GMRAPA1,3,1,0)=$P(GMRAL(GMRAL),U,3)
.K DIK,DA S DIK="^GMR(120.85,",DA=GMRAPA1 D IX^DIK K DIK,DA ;17 changed GMRAPA to GMRAPA1
.D UNLOCK^GMRAUTL(120.85,GMRAPA1)
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR7 1239 printed Nov 22, 2024@16:49:57 Page 2
GMRAOR7 ;HIRMFO/WAA,FPT-OERR HL7 UTILITY ;8/28/03 13:52
+1 ;;4.0;Adverse Reaction Tracking;**4,17**;Mar 29, 1996
ADVERSE(GMRAPA,GMRAL) ;Add a Adverse reaction entry to file 120.85
+1 ;INPUT
+2 ; GMRAPA = the entry in file 120.8 that was added
+3 ; GMRAL = The entry in the GMRAL array that is being added
+4 ;
+5 NEW GMRAO,GMRAPA1,X,Y
+6 SET GMRAO=0
FOR
SET GMRAO=$ORDER(GMRAL(GMRAL,"O",GMRAO))
if GMRAO<1
QUIT
Begin DoDot:1
+7 KILL DD,DO,DIC,DINUM,DLAYGO
+8 SET DIC="^GMR(120.85,"
SET DLAYGO=120.85
SET DIC(0)="L"
SET X=$PIECE(GMRAL(GMRAL,"O",GMRAO),U)
+9 DO FILE^DICN
+10 KILL DD,DO,DIC,DINUM,DLAYGO
+11 if Y=-1
QUIT
SET GMRAPA1=+Y
+12 NEW GMRALN
+13 FOR
if $$LOCK^GMRAUTL(120.85,GMRAPA1)
QUIT
+14 SET GMRALN=^GMR(120.85,GMRAPA1,0)
+15 SET $PIECE(GMRALN,U,2)=GMRADFN
+16 SET $PIECE(GMRALN,U,13)=$PIECE(GMRAL(GMRAL),U,7)
+17 IF $PIECE(GMRAL(GMRAL,"O",GMRAO),U,3)]""
SET $PIECE(GMRALN,U,13)=$PIECE(GMRAL(GMRAL,"O",GMRAO),U,3)
+18 SET $PIECE(GMRALN,U,14)=$PIECE(GMRAL(GMRAL,"O",GMRAO),U,2)
+19 SET $PIECE(GMRALN,U,15)=GMRAPA
+20 SET ^GMR(120.85,GMRAPA1,0)=GMRALN
+21 ;S/S
IF $DATA(GMRAL(GMRAL,"S",1))
DO SIGN^GMRAOR6(120.85,GMRAPA1,.GMRAL)
+22 SET ^GMR(120.85,GMRAPA1,3,0)="^120.8503^1^1"
+23 SET ^GMR(120.85,GMRAPA1,3,1,0)=$PIECE(GMRAL(GMRAL),U,3)
+24 ;17 changed GMRAPA to GMRAPA1
KILL DIK,DA
SET DIK="^GMR(120.85,"
SET DA=GMRAPA1
DO IX^DIK
KILL DIK,DA
+25 DO UNLOCK^GMRAUTL(120.85,GMRAPA1)
+26 QUIT
End DoDot:1
+27 QUIT
