source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAEF.m@ 1581

Last change on this file since 1581 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1GMRAEF ;HIRMFO/WAA-PRINT FDA EXCEPTION REPORT ;11/29/95 14:40
2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
3EN1 ;This is the main entry point for this routine
4 I '$D(^TMP($J,"GMRAEF")) W !,"No data for this REPORT." Q
5PRINTER ;Select printer
6 S GMRAOUT=0,GMRAPG=0
7 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 G EXIT
8 I $D(IO("Q")) D D EXIT Q
9 . S ZTRTN="PRINT^GMRAEF",ZTSAVE("GMRAPG")="",ZTSAVE("GMRAOUT")="",ZTSAVE("^TMP($J,""GMRAEF"",")=""
10 . S:$D(GMRASTDT) ZTSAVE("GMRASTDT")=""
11 . S:$D(GMRAEDT) ZTSAVE("GMRAEDT")=""
12 . S ZTDESC="Print FDA Exception Report" D ^%ZTLOAD
13 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
14 . Q
15 U IO D PRINT U IO(0) D EXIT
16 Q
17PRINT ;Central Print
18 I IOST?1"C".E W @IOF
19 S GMRASTDT=$$FMTE^XLFDT(GMRASTDT,"2P")
20 S:$D(GMRAEDT) GMRAEDT=$$FMTE^XLFDT(GMRAEDT,"2P")
21 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
22 D CLOSE^GMRAUTL
23 Q
24PRT ;Print loop
25 I $Y>(IOSL-3) D HEAD Q:GMRAOUT
26 S GMRABGDT=$O(^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)) Q:GMRABGDT<1 S GMRAIEN=^(GMRABGDT)
27 S GMRA(0)=^GMR(120.8,GMRAIEN,0)
28 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>")
29 G PRT
30HEAD ;Header Print
31HDR ;
32 I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR K DIR I Y'>0 S GMRAOUT=1 Q
33 W @IOF
34HDR1 S GMRAPG=GMRAPG+1 D NOW^%DTC S Y=$$DATE^GMRAUTL1(%)
35 W $P(Y,"@")," ",$P(Y,"@",2),?70,"Page: ",GMRAPG
36 W !,?20,"FDA EXCEPTION REPORT ("
37 W:$D(GMRAEDT) GMRASTDT_" to "_GMRAEDT_")"
38 W:'$D(GMRAEDT) "Starting at "_GMRASTDT_")"
39 W !,"ORIGINATION D/T",?20,"CAUSATIVE AGENT",?50,"ORIGINATOR"
40 W !,$$REPEAT^XLFSTR("-",79),!
41 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
42 Q
43EXIT ;EXIT
44 K ^TMP($J,"GMRAEF")
45 Q
Note: See TracBrowser for help on using the repository browser.