GMRAEF ;HIRMFO/WAA-PRINT FDA EXCEPTION REPORT ;11/29/95 14:40
;;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")
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")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAEF 1938 printed Oct 16, 2024@17:39:53 Page 2
GMRAEF ;HIRMFO/WAA-PRINT FDA EXCEPTION REPORT ;11/29/95 14:40
+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 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)," (",VA("PID"),")"
KILL VA
DO PRT
+5 DO CLOSE^GMRAUTL
+6 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 KILL ^TMP($JOB,"GMRAEF")
+2 QUIT
