source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPFT.m@ 699

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

revised back to 6/30/08 version

File size: 3.2 KB
Line 
1GMRAPFT ;HIRMFO/WAA- PRINT FDA REACTION BY DATE ENTERED/TRACKED ;4/10/97 09:30
2 ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
3EN1 ; This routine will loop through the ADT entry point to get all
4 ; the entries in that date range.
5 S GMRAOUT=0
6 W !,"Select a Tracking date range for this report."
7 D DT^GMRAPL G:GMRAOUT EXIT
8 D PRINTER
9EXIT ; Exit of program kill cleanup
10 D KILL^XUSCLEAN
11 Q
12PRINTER ;Select printer
13 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
14 I $D(IO("Q")) D Q
15 . S ZTRTN="PRINT^GMRAPFT",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
16 . S ZTDESC="List of FDA Reactions over a Date range by Tracking date" D ^%ZTLOAD
17 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
18 . Q
19 U IO D PRINT U IO(0)
20 D EXIT
21 Q
22PRINT ;Queue point for report
23 D NOW^%DTC S GMRADPDT=X
24 S GMRADATE=GMAST-.0001,GMRAPG=1
25 F S GMRADATE=$O(^GMR(120.85,"ARDT",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D Q:GMRAOUT
26 .S GMRAPA1=0
27 .F S GMRAPA1=$O(^GMR(120.85,"ARDT",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT
28 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""
29 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;data entered in error
30 ..D HEAD Q:GMRAOUT
31 ..S (GMRAPID,GMRANAME,GMRALOC)=""
32 ..S GMRADFN=$P(GMRAPA1(0),U,2),GMRADDT=$P(GMRAPA1(0),U)
33 ..D VAD^GMRAUTL1(GMRADFN,GMRADDT,.GMRALOC,.GMRANAME,"",.GMRAPID)
34 ..I GMRALOC="" S GMRALOC="OUT PATIENT"
35 ..E S GMRALOC=$P($G(^DIC(42,GMRALOC,0)),U)
36 ..W !,$E(GMRANAME,1,30) ; Patient Name
37 ..K GMRARAC
38 ..S GMRARAC=0,GMRACNT=1 F S GMRARAC=$O(^GMR(120.85,GMRAPA1,3,GMRARAC)) Q:GMRARAC<1 D
39 ...S GMRARAC(GMRACNT)=$P($G(^GMR(120.85,GMRAPA1,3,GMRARAC,0)),U) Q:GMRARAC(GMRACNT)=""
40 ...S GMRACNT=GMRACNT+1
41 ...Q
42 ..W ?32,"Obs DT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U),"2D") ; Observed Date
43 ..W ?49,$E($G(GMRARAC(1)),1,30) ; The 1st reaction that is listed first
44 ..W !,"(",GMRAPID,")"
45 ..W ?32,"Trk DT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U,18),"2D") ; Tracking Date
46 ..W ?49,$E($G(GMRARAC(2)),1,30) ; The 2nd reaction that is listed
47 ..W !,"Loc: ",GMRALOC
48 ..W ?32,"-------------" ; Seperator
49 ..W ?49,$E($G(GMRARAC(3)),1,30) ; The 3rd reaction that is listed
50 ..W !,"Obs: ",$P($G(^VA(200,$P(GMRAPA1(0),U,19),0)),U) ; User entered
51 ..D
52 ...N X1,X2,X,Y
53 ...S X2=$P(GMRAPA1(0),U),X1=$P(GMRAPA1(0),U,18)
54 ...D ^%DTC
55 ...W ?32,X," Days Difference" ;Difference
56 ...Q
57 ..W ?50,$E($G(GMRARAC(4)),1,30) ; The 4th reaction that is listed
58 ..S GMRACNT=4 F S GMRACNT=$O(GMRARAC(GMRACNT)) Q:GMRACNT<1 W !,?50,$E($G(GMRARAC(GMRACNT)),1,30) ; The Nth reaction that is listed
59 ..W ! ; Put a blank line between the ADRs
60 ..Q
61 .Q
62 D CLOSE^GMRAUTL
63 Q
64HEAD ; Print header information
65 I GMRAPG'=1 Q:$Y<(IOSL-4)
66 I $E(IOST,1)="C" D Q:GMRAOUT
67 .I GMRAPG=1 W @IOF Q
68 .I GMRAPG'=1 D Q:GMRAOUT
69 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
70 ..K Y
71 ..Q
72 .Q
73 Q:GMRAOUT
74 I GMRAPG'=1 W @IOF
75 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
76 W !,?22,"Adverse Reaction Tracking Report"
77 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
78 W !,"Patient",?40,"Dates",?49,"Related Reaction"
79 W !,$$REPEAT^XLFSTR("-",78)
80 S GMRAPG=GMRAPG+1
81 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
82 Q
Note: See TracBrowser for help on using the repository browser.