1 | GMRAPST6 ;HIRMFO/WAA- ADR OUTCOME REPORT ;3/5/97 15:16
|
---|
2 | ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
|
---|
3 | EN1 ; 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 an Observed date range for this report."
|
---|
7 | D DT^GMRAPL G:GMRAOUT EXIT
|
---|
8 | D PRINTER
|
---|
9 | EXIT ; Exit of program kill cleanup
|
---|
10 | D KILL^XUSCLEAN
|
---|
11 | K ^TMP($J,"GMRAPST6")
|
---|
12 | Q
|
---|
13 | PRINTER ;Select printer
|
---|
14 | W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
|
---|
15 | I $D(IO("Q")) D Q
|
---|
16 | . S ZTRTN="PRINT^GMRAPST6",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
|
---|
17 | . S ZTDESC="P&T Committee ADR Outcome Report" D ^%ZTLOAD
|
---|
18 | . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
|
---|
19 | . Q
|
---|
20 | U IO D PRINT U IO(0)
|
---|
21 | Q
|
---|
22 | PRINT ;Queue point for report
|
---|
23 | ;loop through the 120.85 file and look for the field that
|
---|
24 | K ^TMP($J,"GMRAPST6")
|
---|
25 | D NOW^%DTC S GMRADPDT=X
|
---|
26 | S GMRADATE=GMAST-.0001,GMRAPG=1
|
---|
27 | F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D
|
---|
28 | .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D
|
---|
29 | ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node
|
---|
30 | ..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date
|
---|
31 | ..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85
|
---|
32 | ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" ; Bad node
|
---|
33 | ..Q:+$G(^GMR(120.8,GMRAPA,"ER")) ;entered in error data
|
---|
34 | ..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent
|
---|
35 | ..S DFN=$P(GMRAPA(0),U),GMRACA=$E(GMRACA,1,22)_"-"_$E($P(^DPT(DFN,0),U),1)_$E($P(^(0),U,9),6,9)
|
---|
36 | ..Q:'$$PRDTST^GMRAUTL1(DFN) ;GMRA*4*33 Exclude test patients if production or legacy environment.
|
---|
37 | ..S ^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)=""
|
---|
38 | ..Q
|
---|
39 | .Q
|
---|
40 | Q:GMRAOUT
|
---|
41 | I '$D(^TMP($J,"GMRAPST6")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q
|
---|
42 | S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0)))
|
---|
43 | S GMRADDT=0
|
---|
44 | F S GMRADDT=$O(^TMP($J,"GMRAPST6",GMRADDT)) Q:GMRADDT<1 D Q:GMRAOUT
|
---|
45 | .S GMRACA=""
|
---|
46 | .F S GMRACA=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA)) Q:GMRACA="" D Q:GMRAOUT
|
---|
47 | ..S GMRAPA1=0
|
---|
48 | ..F S GMRAPA1=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT
|
---|
49 | ...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))
|
---|
50 | ...Q:GMRAPA(0)=""
|
---|
51 | ...D HEAD Q:GMRAOUT
|
---|
52 | ...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date
|
---|
53 | ...W ?8,"|",GMRACA ; Causative Agent
|
---|
54 | ...W ?38,"|"
|
---|
55 | ...S GMRAREC=0
|
---|
56 | ...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC)
|
---|
57 | ...W ?58,"|" W:$P(GMRAPA1(0),U,4)="y" " Y" ; Req Tx with Rx
|
---|
58 | ...W ?63,"|" W:$P(GMRAPA1(0),U,7)="y" " Y" ; Req Hosp.
|
---|
59 | ...W ?68,"|" W:$P(GMRAPA1(0),U,10)="y" " Y" ; Disability
|
---|
60 | ...W ?73,"|" W:$P(GMRAPA1(0),U,3)="y" " Y" ; Death
|
---|
61 | ...F S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1 D SIGN("1",GMRAREC) Q:GMRAOUT
|
---|
62 | ...Q:GMRAOUT
|
---|
63 | ...D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|",?73,"|"
|
---|
64 | ...Q
|
---|
65 | ..Q
|
---|
66 | .Q
|
---|
67 | D CLOSE^GMRAUTL
|
---|
68 | Q
|
---|
69 | SIGN(CNT,GMRAREC) ; Print Sign/Symptoms
|
---|
70 | N NAM,Y
|
---|
71 | S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0))
|
---|
72 | S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"")
|
---|
73 | I 'CNT W $E(NAM,1,19)
|
---|
74 | E D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|",?73,"|"
|
---|
75 | Q
|
---|
76 | HEAD ; Print header information
|
---|
77 | I GMRAPG'=1 Q:$Y<(IOSL-4)
|
---|
78 | I $E(IOST,1)="C" D Q:GMRAOUT
|
---|
79 | .I GMRAPG=1 W @IOF Q
|
---|
80 | .I GMRAPG'=1 D Q:GMRAOUT
|
---|
81 | ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
|
---|
82 | ..K Y
|
---|
83 | ..Q
|
---|
84 | .Q
|
---|
85 | Q:GMRAOUT
|
---|
86 | I GMRAPG'=1 W @IOF
|
---|
87 | W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
|
---|
88 | W !,?22,"P&T Committee ADR Outcome Report"
|
---|
89 | W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
|
---|
90 | W !,$$REPEAT^XLFSTR("-",79)
|
---|
91 | W !,"Obsv.",?8,"|",?38,"|",?58,"|Req.",?63,"|Req.",?68,"|",?73,"|"
|
---|
92 | W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Tx",?63,"|Hosp",?68,"|Dis.",?73,"|Death"
|
---|
93 | W !,$$REPEAT^XLFSTR("-",79)
|
---|
94 | S GMRAPG=GMRAPG+1
|
---|
95 | I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
|
---|
96 | Q
|
---|