Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRAEF

GMRAEF.m

Go to the documentation of this file.
  1. GMRAEF ;HIRMFO/WAA-PRINT FDA EXCEPTION REPORT ;11/29/95 14:40
  1. ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
  1. EN1 ;This is the main entry point for this routine
  1. I '$D(^TMP($J,"GMRAEF")) W !,"No data for this REPORT." Q
  1. PRINTER ;Select printer
  1. S GMRAOUT=0,GMRAPG=0
  1. W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 G EXIT
  1. I $D(IO("Q")) D D EXIT Q
  1. . S ZTRTN="PRINT^GMRAEF",ZTSAVE("GMRAPG")="",ZTSAVE("GMRAOUT")="",ZTSAVE("^TMP($J,""GMRAEF"",")=""
  1. . S:$D(GMRASTDT) ZTSAVE("GMRASTDT")=""
  1. . S:$D(GMRAEDT) ZTSAVE("GMRAEDT")=""
  1. . S ZTDESC="Print FDA Exception Report" D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
  1. . Q
  1. U IO D PRINT U IO(0) D EXIT
  1. Q
  1. PRINT ;Central Print
  1. I IOST?1"C".E W @IOF
  1. S GMRASTDT=$$FMTE^XLFDT(GMRASTDT,"2P")
  1. S:$D(GMRAEDT) GMRAEDT=$$FMTE^XLFDT(GMRAEDT,"2P")
  1. 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
  1. D CLOSE^GMRAUTL
  1. Q
  1. PRT ;Print loop
  1. I $Y>(IOSL-3) D HEAD Q:GMRAOUT
  1. S GMRABGDT=$O(^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)) Q:GMRABGDT<1 S GMRAIEN=^(GMRABGDT)
  1. S GMRA(0)=^GMR(120.8,GMRAIEN,0)
  1. 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>")
  1. G PRT
  1. HDR ;
  1. I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR K DIR I Y'>0 S GMRAOUT=1 Q
  1. W @IOF
  1. HDR1 S GMRAPG=GMRAPG+1 D NOW^%DTC S Y=$$DATE^GMRAUTL1(%)
  1. W $P(Y,"@")," ",$P(Y,"@",2),?70,"Page: ",GMRAPG
  1. W !,?20,"FDA EXCEPTION REPORT ("
  1. W:$D(GMRAEDT) GMRASTDT_" to "_GMRAEDT_")"
  1. W:'$D(GMRAEDT) "Starting at "_GMRASTDT_")"
  1. W !,"ORIGINATION D/T",?20,"CAUSATIVE AGENT",?50,"ORIGINATOR"
  1. W !,$$REPEAT^XLFSTR("-",79),!
  1. I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
  1. Q
  1. EXIT ;EXIT
  1. K ^TMP($J,"GMRAEF")
  1. Q