GMRAOR7.m

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 ---GMRAOR7   1239     printed  Apr 09, 2024@20:44:54                                                                                                                                                                                                     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