- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST1.m
r613 r623 1 GMRAPST1 ;HIRMFO/WAA- PRINT LISTING OF FATAL REACTIONS ;3/5/97 14:45 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 where the patient has died. 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,"GMRAPST1") 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^GMRAPST1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 17 . S ZTDESC="List of Fatal Reaction over a date range" 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. 24 K ^TMP($J,"GMRAPST1") 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 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;data entered in error 31 ..Q:$P(GMRAPA1(0),U,3)'="y" ; If patient did not die of the reaction 32 ..S GMRADFN=$P(GMRAPA1(0),U,2),GMRADDT=$P(GMRAPA1(0),U) ; reaction date 33 ..Q:'$$PRDTST^GMRAUTL1(GMRADFN) ;GMRA*4*33 Exclude test patient from report in production or legacy environments. 34 ..S (GMRAPID,GMRANAME)="" 35 ..D VAD^GMRAUTL1(GMRADFN,GMRADDT,"",.GMRANAME,"",.GMRAPID) 36 ..S GMRADIED=$P($G(^DPT(GMRADFN,.35)),U) ; Date patient died 37 ..S ^TMP($J,"GMRAPST1",$E(GMRANAME,1,30),GMRAPID,GMRADDT,GMRAPA1)=GMRADIED 38 ..Q 39 .Q 40 Q:GMRAOUT 41 I '$D(^TMP($J,"GMRAPST1")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q 42 S GMRANAME="" 43 F S GMRANAME=$O(^TMP($J,"GMRAPST1",GMRANAME)) Q:GMRANAME="" D Q:GMRAOUT 44 .S GMRAPID="" 45 .F S GMRAPID=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID)) Q:GMRAPID="" D Q:GMRAOUT 46 ..D HEAD Q:GMRAOUT 47 ..W !,$E(GMRANAME,1,22)," (",$E(GMRANAME,1),$P(GMRAPID,"-",3),")" 48 ..S GMRADDT=0 49 ..F S GMRADDT=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT)) Q:GMRADDT<1 D Q:GMRAOUT 50 ...S GMRAPA1=0 51 ...F S GMRAPA1=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT W ! 52 ....S GMRADIED=^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT,GMRAPA1) 53 ....W ?31,$$FMTE^XLFDT($P(^GMR(120.85,GMRAPA1,0),U),"2D") 54 ....S GMRAX="",GMRACNT=1 K GMRARX 55 ....F S GMRAX=$O(^GMR(120.85,GMRAPA1,3,"B",GMRAX)) Q:GMRAX="" D 56 .....S GMRARX(GMRACNT)=GMRAX,GMRACNT=GMRACNT+1 57 .....Q 58 ....W ?40,GMRARX(1),?70,$$FMTE^XLFDT(GMRADIED,"2D") 59 ....D HEAD Q:GMRAOUT 60 ....S GMRACNT=1 F S GMRACNT=$O(GMRARX(GMRACNT)) Q:GMRACNT<1 D Q:GMRAOUT 61 .....W !,?40,GMRARX(GMRACNT) D HEAD Q:GMRAOUT 62 .....Q 63 ....Q 64 ...Q 65 ..W ! D HEAD Q:GMRAOUT 66 ..Q 67 .Q 68 D CLOSE^GMRAUTL 69 Q 70 ;has the patient died within the date 71 HEAD ; Print header information 72 I GMRAPG'=1 Q:$Y<(IOSL-4) 73 I $E(IOST,1)="C" D Q:GMRAOUT 74 .I GMRAPG=1 W @IOF Q 75 .I GMRAPG'=1 D Q:GMRAOUT 76 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 77 ..K Y 78 ..Q 79 .Q 80 Q:GMRAOUT 81 I GMRAPG'=1 W @IOF 82 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 83 W !,?22,"List of Fatal Reaction over a date range" 84 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 85 W !,"Patient",?31,"Dates",?40,"Related Reaction",?70,"Date Died" 86 W !,$$REPEAT^XLFSTR("-",79) 87 S GMRAPG=GMRAPG+1 88 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 89 Q 1 GMRAPST1 ;HIRMFO/WAA- PRINT LISTING OF FATAL REACTIONS ;3/5/97 14:45 2 ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996 3 EN1 ; This routine will loop through the ADT entry point to get all 4 ; the entries where the patient has died. 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,"GMRAPST1") 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^GMRAPST1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 17 . S ZTDESC="List of Fatal Reaction over a date range" 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. 24 K ^TMP($J,"GMRAPST1") 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 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;data entered in error 31 ..Q:$P(GMRAPA1(0),U,3)'="y" ; If patient did not die of the reaction 32 ..S GMRADFN=$P(GMRAPA1(0),U,2),GMRADDT=$P(GMRAPA1(0),U) ; reaction date 33 ..S (GMRAPID,GMRANAME)="" 34 ..D VAD^GMRAUTL1(GMRADFN,GMRADDT,"",.GMRANAME,"",.GMRAPID) 35 ..S GMRADIED=$P($G(^DPT(GMRADFN,.35)),U) ; Date patient died 36 ..S ^TMP($J,"GMRAPST1",$E(GMRANAME,1,30),GMRAPID,GMRADDT,GMRAPA1)=GMRADIED 37 ..Q 38 .Q 39 Q:GMRAOUT 40 I '$D(^TMP($J,"GMRAPST1")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q 41 S GMRANAME="" 42 F S GMRANAME=$O(^TMP($J,"GMRAPST1",GMRANAME)) Q:GMRANAME="" D Q:GMRAOUT 43 .S GMRAPID="" 44 .F S GMRAPID=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID)) Q:GMRAPID="" D Q:GMRAOUT 45 ..D HEAD Q:GMRAOUT 46 ..W !,$E(GMRANAME,1,22)," (",$E(GMRANAME,1),$P(GMRAPID,"-",3),")" 47 ..S GMRADDT=0 48 ..F S GMRADDT=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT)) Q:GMRADDT<1 D Q:GMRAOUT 49 ...S GMRAPA1=0 50 ...F S GMRAPA1=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT W ! 51 ....S GMRADIED=^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT,GMRAPA1) 52 ....W ?31,$$FMTE^XLFDT($P(^GMR(120.85,GMRAPA1,0),U),"2D") 53 ....S GMRAX="",GMRACNT=1 K GMRARX 54 ....F S GMRAX=$O(^GMR(120.85,GMRAPA1,3,"B",GMRAX)) Q:GMRAX="" D 55 .....S GMRARX(GMRACNT)=GMRAX,GMRACNT=GMRACNT+1 56 .....Q 57 ....W ?40,GMRARX(1),?70,$$FMTE^XLFDT(GMRADIED,"2D") 58 ....D HEAD Q:GMRAOUT 59 ....S GMRACNT=1 F S GMRACNT=$O(GMRARX(GMRACNT)) Q:GMRACNT<1 D Q:GMRAOUT 60 .....W !,?40,GMRARX(GMRACNT) D HEAD Q:GMRAOUT 61 .....Q 62 ....Q 63 ...Q 64 ..W ! D HEAD Q:GMRAOUT 65 ..Q 66 .Q 67 D CLOSE^GMRAUTL 68 Q 69 ;has the patient died with inthe dat 70 HEAD ; Print header information 71 I GMRAPG'=1 Q:$Y<(IOSL-4) 72 I $E(IOST,1)="C" D Q:GMRAOUT 73 .I GMRAPG=1 W @IOF Q 74 .I GMRAPG'=1 D Q:GMRAOUT 75 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 76 ..K Y 77 ..Q 78 .Q 79 Q:GMRAOUT 80 I GMRAPG'=1 W @IOF 81 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 82 W !,?22,"List of Fatal Reaction over a date range" 83 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 84 W !,"Patient",?31,"Dates",?40,"Related Reaction",?70,"Date Died" 85 W !,$$REPEAT^XLFSTR("-",79) 86 S GMRAPG=GMRAPG+1 87 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 88 Q
Note:
See TracChangeset
for help on using the changeset viewer.
