GMRAPST6.m

GMRAPST6 ;HIRMFO/WAA- ADR OUTCOME REPORT ;3/5/97  15:16

 ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5

EN1 ; This routine will loop through the ADT entry point to get all

 ; the entries in that date range.

 S GMRAOUT=0

 W !,"Select an Observed date range for this report."

 D DT^GMRAPL G:GMRAOUT EXIT

 D PRINTER

EXIT ; Exit of program kill cleanup

 D KILL^XUSCLEAN

 K ^TMP($J,"GMRAPST6")

 Q

PRINTER ;Select printer

 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q

 I $D(IO("Q")) D  Q

 . S ZTRTN="PRINT^GMRAPST6",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""

 . S ZTDESC="P&T Committee ADR Outcome Report" D ^%ZTLOAD

 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")

 . Q

 U IO D PRINT U IO(0)

 Q

PRINT ;Queue point for report

 ;loop through the 120.85 file and look for the field that 

 K ^TMP($J,"GMRAPST6")

 D NOW^%DTC S GMRADPDT=X

 S GMRADATE=GMAST-.0001,GMRAPG=1

 F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D

 .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D

 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node

 ..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date

 ..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85

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

 ..Q:+$G(^GMR(120.8,GMRAPA,"ER"))  ;entered in error data

 ..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent

 ..S DFN=$P(GMRAPA(0),U),GMRACA=$E(GMRACA,1,22)_"-"_$E($P(^DPT(DFN,0),U),1)_$E($P(^(0),U,9),6,9)

 ..Q:'$$PRDTST^GMRAUTL1(DFN)  ;GMRA*4*33 Exclude test patients if production or legacy environment.

 ..S ^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)=""

 ..Q

 .Q

 Q:GMRAOUT

 I '$D(^TMP($J,"GMRAPST6")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q

 S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0)))

 S GMRADDT=0

 F  S GMRADDT=$O(^TMP($J,"GMRAPST6",GMRADDT)) Q:GMRADDT<1  D  Q:GMRAOUT

 .S GMRACA=""

 .F  S GMRACA=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA)) Q:GMRACA=""  D  Q:GMRAOUT

 ..S GMRAPA1=0

 ..F  S GMRAPA1=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT

 ...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))

 ...Q:GMRAPA(0)=""

 ...D HEAD Q:GMRAOUT

 ...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date

 ...W ?8,"|",GMRACA ; Causative Agent

 ...W ?38,"|"

 ...S GMRAREC=0

 ...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC)

 ...W ?58,"|" W:$P(GMRAPA1(0),U,4)="y" " Y" ; Req Tx with Rx

 ...W ?63,"|" W:$P(GMRAPA1(0),U,7)="y" " Y" ; Req Hosp.

 ...W ?68,"|" W:$P(GMRAPA1(0),U,10)="y" " Y" ; Disability

 ...W ?73,"|" W:$P(GMRAPA1(0),U,3)="y" " Y" ; Death

 ...F  S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1  D SIGN("1",GMRAREC) Q:GMRAOUT

 ...Q:GMRAOUT

 ...D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|",?73,"|"

 ...Q

 ..Q

 .Q

 D CLOSE^GMRAUTL

 Q

SIGN(CNT,GMRAREC) ; Print Sign/Symptoms

 N NAM,Y

 S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0))

 S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"")

 I 'CNT W $E(NAM,1,19)

 E  D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|",?73,"|"

 Q

HEAD ; Print header information

 I GMRAPG'=1  Q:$Y<(IOSL-4)

 I $E(IOST,1)="C" D  Q:GMRAOUT

 .I GMRAPG=1 W @IOF Q

 .I GMRAPG'=1 D  Q:GMRAOUT

 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1

 ..K Y

 ..Q

 .Q

 Q:GMRAOUT

 I GMRAPG'=1 W @IOF

 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG

 W !,?22,"P&T Committee ADR Outcome Report"

 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")

 W !,$$REPEAT^XLFSTR("-",79)

 W !,"Obsv.",?8,"|",?38,"|",?58,"|Req.",?63,"|Req.",?68,"|",?73,"|"

 W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Tx",?63,"|Hosp",?68,"|Dis.",?73,"|Death"

 W !,$$REPEAT^XLFSTR("-",79)

 S GMRAPG=GMRAPG+1

 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRAPST6   4019     printed  Mar 13, 2025@20:45                                                                                                                                                                                                       Page 2

GMRAPST6  ;HIRMFO/WAA- ADR OUTCOME REPORT ;3/5/97  15:16

 +1       ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5

EN1       ; This routine will loop through the ADT entry point to get all

 +1       ; the entries in that date range.

 +2        SET GMRAOUT=0

 +3        WRITE !,"Select an Observed date range for this report."

 +4        DO DT^GMRAPL

           if GMRAOUT

               GOTO EXIT

 +5        DO PRINTER

EXIT      ; Exit of program kill cleanup

 +1        DO KILL^XUSCLEAN

 +2        KILL ^TMP($JOB,"GMRAPST6")

 +3        QUIT 

PRINTER   ;Select printer

 +1        WRITE !

           KILL GMRAZIS

           DO DEV^GMRAUTL

           IF POP

               WRITE !,"PLEASE TRY LATER"

               SET GMRAOUT=1

               QUIT 

 +2        IF $DATA(IO("Q"))

               Begin DoDot:1

 +3                SET ZTRTN="PRINT^GMRAPST6"

                   SET (ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""

 +4                SET ZTDESC="P&T Committee ADR Outcome Report"

                   DO ^%ZTLOAD

 +5                WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")

 +6                QUIT 

               End DoDot:1

               QUIT 

 +7        USE IO

           DO PRINT

           USE IO(0)

 +8        QUIT 

PRINT     ;Queue point for report

 +1       ;loop through the 120.85 file and look for the field that 

 +2        KILL ^TMP($JOB,"GMRAPST6")

 +3        DO NOW^%DTC

           SET GMRADPDT=X

 +4        SET GMRADATE=GMAST-.0001

           SET GMRAPG=1

 +5        FOR 

               SET GMRADATE=$ORDER(^GMR(120.85,"B",GMRADATE))

               if GMRADATE<1

                   QUIT 

               if GMRADATE>GMAEN

                   QUIT 

               Begin DoDot:1

 +6                SET GMRAPA1=0

                   FOR 

                       SET GMRAPA1=$ORDER(^GMR(120.85,"B",GMRADATE,GMRAPA1))

                       if GMRAPA1<1

                           QUIT 

                       Begin DoDot:2

 +7       ;Bad Node

                           SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))

                           if GMRAPA1(0)=""

                               QUIT 

 +8       ; reaction date

                           SET GMRADDT=$PIECE(GMRAPA1(0),U)

 +9       ; Get the 120.8 entry for this reaction in 120.85

                           SET GMRAPA=$PIECE(GMRAPA1(0),U,15)

 +10      ; Bad node

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

                           if GMRAPA(0)=""

                               QUIT 

 +11      ;entered in error data

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

                               QUIT 

 +12      ; Causative Agent

                           SET GMRACA=$PIECE(GMRAPA(0),U,2)

 +13                       SET DFN=$PIECE(GMRAPA(0),U)

                           SET GMRACA=$EXTRACT(GMRACA,1,22)_"-"_$EXTRACT($PIECE(^DPT(DFN,0),U),1)_$EXTRACT($PIECE(^(0),U,9),6,9)

 +14      ;GMRA*4*33 Exclude test patients if production or legacy environment.

                           if '$$PRDTST^GMRAUTL1(DFN)

                               QUIT 

 +15                       SET ^TMP($JOB,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)=""

 +16                       QUIT 

                       End DoDot:2

 +17               QUIT 

               End DoDot:1

 +18       if GMRAOUT

               QUIT 

 +19       IF '$DATA(^TMP($JOB,"GMRAPST6"))

               DO HEAD

               WRITE !,"NO DATA FOR THIS REPORT..."

               QUIT 

 +20       SET GMRAOTH=$GET(GMRAOTH,$ORDER(^GMRD(120.83,"B","OTHER REACTION",0)))

 +21       SET GMRADDT=0

 +22       FOR 

               SET GMRADDT=$ORDER(^TMP($JOB,"GMRAPST6",GMRADDT))

               if GMRADDT<1

                   QUIT 

               Begin DoDot:1

 +23               SET GMRACA=""

 +24               FOR 

                       SET GMRACA=$ORDER(^TMP($JOB,"GMRAPST6",GMRADDT,GMRACA))

                       if GMRACA=""

                           QUIT 

                       Begin DoDot:2

 +25                       SET GMRAPA1=0

 +26                       FOR 

                               SET GMRAPA1=$ORDER(^TMP($JOB,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1))

                               if GMRAPA1<1

                                   QUIT 

                               Begin DoDot:3

 +27                               SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))

 +28                               if GMRAPA(0)=""

                                       QUIT 

 +29                               DO HEAD

                                   if GMRAOUT

                                       QUIT 

 +30      ; Obs Date

                                   WRITE !,$JUSTIFY($$FMTE^XLFDT(GMRADDT,"2D"),8)

 +31      ; Causative Agent

                                   WRITE ?8,"|",GMRACA

 +32                               WRITE ?38,"|"

 +33                               SET GMRAREC=0

 +34                               SET GMRAREC=$ORDER(^GMR(120.85,GMRAPA1,2,0))

                                   if GMRAREC>0

                                       DO SIGN("0",GMRAREC)

 +35      ; Req Tx with Rx

                                   WRITE ?58,"|"

                                   if $PIECE(GMRAPA1(0),U,4)="y"

                                       WRITE " Y"

 +36      ; Req Hosp.

                                   WRITE ?63,"|"

                                   if $PIECE(GMRAPA1(0),U,7)="y"

                                       WRITE " Y"

 +37      ; Disability

                                   WRITE ?68,"|"

                                   if $PIECE(GMRAPA1(0),U,10)="y"

                                       WRITE " Y"

 +38      ; Death

                                   WRITE ?73,"|"

                                   if $PIECE(GMRAPA1(0),U,3)="y"

                                       WRITE " Y"

 +39                               FOR 

                                       SET GMRAREC=$ORDER(^GMR(120.85,GMRAPA1,2,GMRAREC))

                                       if GMRAREC<1

                                           QUIT 

                                       DO SIGN("1",GMRAREC)

                                       if GMRAOUT

                                           QUIT 

 +40                               if GMRAOUT

                                       QUIT 

 +41                               DO HEAD

                                   if GMRAOUT

                                       QUIT 

                                   WRITE !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|",?73,"|"

 +42                               QUIT 

                               End DoDot:3

                               if GMRAOUT

                                   QUIT 

 +43                       QUIT 

                       End DoDot:2

                       if GMRAOUT

                           QUIT 

 +44               QUIT 

               End DoDot:1

               if GMRAOUT

                   QUIT 

 +45       DO CLOSE^GMRAUTL

 +46       QUIT 

SIGN(CNT,GMRAREC) ; Print Sign/Symptoms

 +1        NEW NAM,Y

 +2        SET Y=$GET(^GMR(120.85,GMRAPA1,2,GMRAREC,0))

 +3        SET NAM=$SELECT(+Y=GMRAOTH:$PIECE(Y,U,2),$DATA(^GMRD(120.83,+Y,0)):$PIECE(^GMRD(120.83,+Y,0),U),1:"")

 +4        IF 'CNT

               WRITE $EXTRACT(NAM,1,19)

 +5       IF '$TEST

               DO HEAD

               if GMRAOUT

                   QUIT 

               WRITE !,?8,"|",?38,"|",$EXTRACT(NAM,1,19),?58,"|",?63,"|",?68,"|",?73,"|"

 +6        QUIT 

HEAD      ; Print header information

 +1        IF GMRAPG'=1

               if $Y<(IOSL-4)

                   QUIT 

 +2        IF $EXTRACT(IOST,1)="C"

               Begin DoDot:1

 +3                IF GMRAPG=1

                       WRITE @IOF

                       QUIT 

 +4                IF GMRAPG'=1

                       Begin DoDot:2

 +5                        NEW DIR

                           SET DIR(0)="E"

                           DO ^DIR

                           IF 'Y

                               SET GMRAOUT=1

 +6                        KILL Y

 +7                        QUIT 

                       End DoDot:2

                       if GMRAOUT

                           QUIT 

 +8                QUIT 

               End DoDot:1

               if GMRAOUT

                   QUIT 

 +9        if GMRAOUT

               QUIT 

 +10       IF GMRAPG'=1

               WRITE @IOF

 +11       WRITE "Report Date: ",$PIECE($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG

 +12       WRITE !,?22,"P&T Committee ADR Outcome Report"

 +13       WRITE !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")

 +14       WRITE !,$$REPEAT^XLFSTR("-",79)

 +15       WRITE !,"Obsv.",?8,"|",?38,"|",?58,"|Req.",?63,"|Req.",?68,"|",?73,"|"

 +16       WRITE !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Tx",?63,"|Hosp",?68,"|Dis.",?73,"|Death"

 +17       WRITE !,$$REPEAT^XLFSTR("-",79)

 +18       SET GMRAPG=GMRAPG+1

 +19      ; Check if stopped by user

           IF $DATA(ZTQUEUED)

               if $$STPCK^GMRAUTL1

                   SET GMRAOUT=1

 +20       QUIT