- 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
- 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