GMRAEF.m

GMRAEF ;HIRMFO/WAA-PRINT FDA EXCEPTION REPORT ;11/29/95  14:40 [ 05/02/2002  10:45 AM ]

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

EN1 ;This is the main entry point for this routine

 I '$D(^TMP($J,"GMRAEF")) W !,"No data for this REPORT." Q

PRINTER ;Select printer

 S GMRAOUT=0,GMRAPG=0

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

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

 . S ZTRTN="PRINT^GMRAEF",ZTSAVE("GMRAPG")="",ZTSAVE("GMRAOUT")="",ZTSAVE("^TMP($J,""GMRAEF"",")=""

 . S:$D(GMRASTDT) ZTSAVE("GMRASTDT")=""

 . S:$D(GMRAEDT) ZTSAVE("GMRAEDT")=""

 . S ZTDESC="Print FDA Exception Report" D ^%ZTLOAD

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

 . Q

 U IO D PRINT U IO(0) D EXIT

 Q

PRINT ;Central Print

 I IOST?1"C".E W @IOF

 S GMRASTDT=$$FMTE^XLFDT(GMRASTDT,"2P")

 S:$D(GMRAEDT) GMRAEDT=$$FMTE^XLFDT(GMRAEDT,"2P")

 ;IHS/ITSC/ENM 04/30/02 HRN CALL ADDED, HRCN VAR SET IN VADPT6

 D HDR1 S GMRDFN=0 F  S GMRDFN=$O(^TMP($J,"GMRAEF",GMRDFN)) Q:GMRDFN<1!(GMRAOUT)  S GMRABGDT=0 S DFN=GMRDFN D PID^VADPT6 W !,?5,"Patient: ",$P(^DPT(GMRDFN,0),U)," (HRN: ",HRCN,")" K VA D PRT

 ;D HDR1 S GMRDFN=0 F  S GMRDFN=$O(^TMP($J,"GMRAEF",GMRDFN)) Q:GMRDFN<1!(GMRAOUT)  S GMRABGDT=0 S DFN=GMRDFN D PID^VADPT6 W !,?5,"Patient: ",$P(^DPT(GMRDFN,0),U)," (",VA("PID"),")" K VA D PRT

 D CLOSE^GMRAUTL

 Q

PRT ;Print loop

 I $Y>(IOSL-3) D HEAD Q:GMRAOUT

 S GMRABGDT=$O(^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)) Q:GMRABGDT<1  S GMRAIEN=^(GMRABGDT)

 S GMRA(0)=^GMR(120.8,GMRAIEN,0)

 W !,$$DATE^GMRAUTL1(GMRABGDT),?20,$P(GMRA(0),U,2),?50,$S($P(GMRA(0),U,5)'="":$P(^VA(200,$P(GMRA(0),U,5),0),U),1:"<None>")

 G PRT

HEAD ;Header Print

HDR ;

 I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR K DIR I Y'>0 S GMRAOUT=1 Q

 W @IOF

HDR1 S GMRAPG=GMRAPG+1 D NOW^%DTC S Y=$$DATE^GMRAUTL1(%)

 W $P(Y,"@")," ",$P(Y,"@",2),?70,"Page: ",GMRAPG

 W !,?20,"FDA EXCEPTION REPORT ("

 W:$D(GMRAEDT) GMRASTDT_" to "_GMRAEDT_")"

 W:'$D(GMRAEDT) "Starting at "_GMRASTDT_")"

 W !,"ORIGINATION D/T",?20,"CAUSATIVE AGENT",?50,"ORIGINATOR"

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

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

 Q

EXIT ;EXIT

 K ^TMP($J,"GMRAEF"),HRCN ;IHS/ITSC/ENM 05/02/02

 Q

GMRAEF    ;HIRMFO/WAA-PRINT FDA EXCEPTION REPORT ;11/29/95  14:40 [ 05/02/2002  10:45 AM ]

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

EN1       ;This is the main entry point for this routine

 +1        IF '$DATA(^TMP($JOB,"GMRAEF"))

               WRITE !,"No data for this REPORT."

               QUIT 

PRINTER   ;Select printer

 +1        SET GMRAOUT=0

           SET GMRAPG=0

 +2        WRITE !

           KILL GMRAZIS

           DO DEV^GMRAUTL

           IF POP

               WRITE !,"PLEASE TRY LATER"

               SET GMRAOUT=1

               GOTO EXIT

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

               Begin DoDot:1

 +4                SET ZTRTN="PRINT^GMRAEF"

                   SET ZTSAVE("GMRAPG")=""

                   SET ZTSAVE("GMRAOUT")=""

                   SET ZTSAVE("^TMP($J,""GMRAEF"",")=""

 +5                IF $DATA(GMRASTDT)

                       SET ZTSAVE("GMRASTDT")=""

 +6                IF $DATA(GMRAEDT)

                       SET ZTSAVE("GMRAEDT")=""

 +7                SET ZTDESC="Print FDA Exception Report"

                   DO ^%ZTLOAD

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

 +9                QUIT 

               End DoDot:1

               DO EXIT

               QUIT 

 +10       USE IO

           DO PRINT

           USE IO(0)

           DO EXIT

 +11       QUIT 

PRINT     ;Central Print

 +1        IF IOST?1"C".E

               WRITE @IOF

 +2        SET GMRASTDT=$$FMTE^XLFDT(GMRASTDT,"2P")

 +3        IF $DATA(GMRAEDT)

               SET GMRAEDT=$$FMTE^XLFDT(GMRAEDT,"2P")

 +4       ;IHS/ITSC/ENM 04/30/02 HRN CALL ADDED, HRCN VAR SET IN VADPT6

 +5        DO HDR1

           SET GMRDFN=0

           FOR 

               SET GMRDFN=$ORDER(^TMP($JOB,"GMRAEF",GMRDFN))

               IF GMRDFN<1!(GMRAOUT)

                   QUIT 

               SET GMRABGDT=0

               SET DFN=GMRDFN

               DO PID^VADPT6

               WRITE !,?5,"Patient: ",$PIECE(^DPT(GMRDFN,0),U)," (HRN: ",HRCN,")"

               KILL VA

               DO PRT

 +6       ;D HDR1 S GMRDFN=0 F  S GMRDFN=$O(^TMP($J,"GMRAEF",GMRDFN)) Q:GMRDFN<1!(GMRAOUT)  S GMRABGDT=0 S DFN=GMRDFN D PID^VADPT6 W !,?5,"Patient: ",$P(^DPT(GMRDFN,0),U)," (",VA("PID"),")" K VA D PRT

 +7        DO CLOSE^GMRAUTL

 +8        QUIT 

PRT       ;Print loop

 +1        IF $Y>(IOSL-3)

               DO HEAD

               IF GMRAOUT

                   QUIT 

 +2        SET GMRABGDT=$ORDER(^TMP($JOB,"GMRAEF",GMRDFN,GMRABGDT))

           IF GMRABGDT<1

               QUIT 

           SET GMRAIEN=^(GMRABGDT)

 +3        SET GMRA(0)=^GMR(120.8,GMRAIEN,0)

 +4        WRITE !,$$DATE^GMRAUTL1(GMRABGDT),?20,$PIECE(GMRA(0),U,2),?50,$SELECT($PIECE(GMRA(0),U,5)'="":$PIECE(^VA(200,$PIECE(GMRA(0),U,5),0),U),1:"<None>")

 +5        GOTO PRT

HEAD      ;Header Print

HDR       ;

 +1        IF IOST?1"C".E

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               IF Y'>0

                   SET GMRAOUT=1

                   QUIT 

 +2        WRITE @IOF

HDR1       SET GMRAPG=GMRAPG+1

           DO NOW^%DTC

           SET Y=$$DATE^GMRAUTL1(%)

 +1        WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2),?70,"Page: ",GMRAPG

 +2        WRITE !,?20,"FDA EXCEPTION REPORT ("

 +3        IF $DATA(GMRAEDT)

               WRITE GMRASTDT_" to "_GMRAEDT_")"

 +4        IF '$DATA(GMRAEDT)

               WRITE "Starting at "_GMRASTDT_")"

 +5        WRITE !,"ORIGINATION D/T",?20,"CAUSATIVE AGENT",?50,"ORIGINATOR"

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

 +7       ; Check if stopped by user

           IF $DATA(ZTQUEUED)

               IF $$STPCK^GMRAUTL1

                   SET GMRAOUT=1

 +8        QUIT 

EXIT      ;EXIT

 +1       ;IHS/ITSC/ENM 05/02/02

           KILL ^TMP($JOB,"GMRAEF"),HRCN

 +2        QUIT