- 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 Feb 18, 2025@23:05:24 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