GMRADSP0.m

GMRADSP0 ;HIRMFO/WAA-DISPLAY ALLERGY ;9/6/95  11:06

 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996

EN1(GMRAL) ; This routine will print all the reaction in the GMRAL array

 ; for the given DFN.

 ;   Input variables:

 ;       GMRAL = An array of all the patient allergies.

 ;

 K ^TMP($J,"GMRALST")

 N GMRATYPE,GMRALN,GMRANAME,GMRAPA

 I $D(XRTL) D T0^%ZOSV ; START RT

 S GMRAOUT=0,GMRAOSOF=1

 I $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV ; STOP RT

 ;sort list builder subroutine

 ;This subroutine builds the a ^TMP array in the following format:

 ;   ^TMP($J,"GMRALST",type,name,ien)=""

 I GMRAL S GMRAPA=0 F  S GMRAPA=$O(GMRAL(GMRAPA)) Q:GMRAPA<1  D

 .Q:+$G(^GMR(120.8,GMRAPA,"ER"))  ;Check for E/E

 .S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""

 .S ^TMP($J,"GMRALST",$P(GMRAPA(0),U,20),$P(GMRAPA(0),U,2),GMRAPA)=""

 .Q

ALLTYP ;Loop through the list created by the sort subroutine and print.

 D HEAD^GMRADSP8

 S GMRATYPE="" F  S GMRATYPE=$O(^TMP($J,"GMRALST",GMRATYPE)) Q:GMRATYPE=""  D  Q:GMRAOUT

 .S GMRANAME="" F  S GMRANAME=$O(^TMP($J,"GMRALST",GMRATYPE,GMRANAME)) Q:GMRANAME=""  D  Q:GMRAOUT

 .. S GMRAPA=0 F  S GMRAPA=$O(^TMP($J,"GMRALST",GMRATYPE,GMRANAME,GMRAPA)) Q:GMRAPA<1  D  Q:GMRAOUT

 ...N GMALN

 ...D DISBLD^GMRADSP1(GMRAPA,.GMALN)

 ...D DISPLAY^GMRADSP8(.GMALN) Q:GMRAOUT

 ...Q

 ..Q

 .Q

 S:GMRAOUT GMRAOUT=2-GMRAOUT

 Q

EXIT ;Exit

 K ^TMP($J,"GMRALST")

 S:GMRAOUT GMRAOUT=2-GMRAOUT

 Q

GMRADSP0  ;HIRMFO/WAA-DISPLAY ALLERGY ;9/6/95  11:06

 +1       ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996

EN1(GMRAL) ; This routine will print all the reaction in the GMRAL array

 +1       ; for the given DFN.

 +2       ;   Input variables:

 +3       ;       GMRAL = An array of all the patient allergies.

 +4       ;

 +5        KILL ^TMP($JOB,"GMRALST")

 +6        NEW GMRATYPE,GMRALN,GMRANAME,GMRAPA

 +7       ; START RT

           IF $DATA(XRTL)

               DO T0^%ZOSV

 +8        SET GMRAOUT=0

           SET GMRAOSOF=1

 +9       ; STOP RT

           IF $DATA(XRT0)

               SET XRTN=$TEXT(+0)

               DO T1^%ZOSV

 +10      ;sort list builder subroutine

 +11      ;This subroutine builds the a ^TMP array in the following format:

 +12      ;   ^TMP($J,"GMRALST",type,name,ien)=""

 +13       IF GMRAL

               SET GMRAPA=0

               FOR 

                   SET GMRAPA=$ORDER(GMRAL(GMRAPA))

                   IF GMRAPA<1

                       QUIT 

                   Begin DoDot:1

 +14      ;Check for E/E

                       IF +$GET(^GMR(120.8,GMRAPA,"ER"))

                           QUIT 

 +15                   SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))

                       IF GMRAPA(0)=""

                           QUIT 

 +16                   SET ^TMP($JOB,"GMRALST",$PIECE(GMRAPA(0),U,20),$PIECE(GMRAPA(0),U,2),GMRAPA)=""

 +17                   QUIT 

                   End DoDot:1

ALLTYP    ;Loop through the list created by the sort subroutine and print.

 +1        DO HEAD^GMRADSP8

 +2        SET GMRATYPE=""

           FOR 

               SET GMRATYPE=$ORDER(^TMP($JOB,"GMRALST",GMRATYPE))

               IF GMRATYPE=""

                   QUIT 

               Begin DoDot:1

 +3                SET GMRANAME=""

                   FOR 

                       SET GMRANAME=$ORDER(^TMP($JOB,"GMRALST",GMRATYPE,GMRANAME))

                       IF GMRANAME=""

                           QUIT 

                       Begin DoDot:2

 +4                        SET GMRAPA=0

                           FOR 

                               SET GMRAPA=$ORDER(^TMP($JOB,"GMRALST",GMRATYPE,GMRANAME,GMRAPA))

                               IF GMRAPA<1

                                   QUIT 

                               Begin DoDot:3

 +5                                NEW GMALN

 +6                                DO DISBLD^GMRADSP1(GMRAPA,.GMALN)

 +7                                DO DISPLAY^GMRADSP8(.GMALN)

                                   IF GMRAOUT

                                       QUIT 

 +8                                QUIT 

                               End DoDot:3

                               IF GMRAOUT

                                   QUIT 

 +9                        QUIT 

                       End DoDot:2

                       IF GMRAOUT

                           QUIT 

 +10               QUIT 

               End DoDot:1

               IF GMRAOUT

                   QUIT 

 +11       IF GMRAOUT

               SET GMRAOUT=2-GMRAOUT

 +12       QUIT 

EXIT      ;Exit

 +1        KILL ^TMP($JOB,"GMRALST")

 +2        IF GMRAOUT

               SET GMRAOUT=2-GMRAOUT

 +3        QUIT