GMRAOR6.m

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

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