- 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/GMRAPST7.m
r613 r623 1 GMRAPST7 ;HIRMFO/WAA- ADVERSE DRUG REACTION REPORT ;3/5/97 15:17 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,"GMRAPST7") 12 Q 13 PRINTER ;Select printer 14 W !!,"This report required a 132 column printer." 15 K GMRAZIS S GMRAZIS="M132" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 16 I $D(IO("Q")) D Q 17 . S ZTRTN="PRINT^GMRAPST7",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 18 . S ZTDESC="P&T Committee ADR Report" D ^%ZTLOAD 19 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 20 . Q 21 U IO D PRINT U IO(0) 22 Q 23 PRINT ;Queue point for report 24 ;loop through the 120.85 file and look for the field that 25 K ^TMP($J,"GMRAPST7") 26 D NOW^%DTC S GMRADPDT=X 27 S GMRADATE=GMAST-.0001,GMRAPG=1 28 F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D 29 .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D 30 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node 31 ..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date 32 ..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85 33 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" ; Bad node 34 ..Q:+$G(^GMR(120.8,GMRAPA,"ER")) ;Entered in error data 35 ..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent 36 ..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) 37 ..Q:'$$PRDTST^GMRAUTL1(DFN) ;GMRA*4*33 Exclude test patients from report if production or legacy environment. 38 ..S ^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)=GMRAPA 39 ..Q 40 .Q 41 Q:GMRAOUT 42 I '$D(^TMP($J,"GMRAPST7")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q 43 S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0))) 44 S GMRADDT=0 45 F S GMRADDT=$O(^TMP($J,"GMRAPST7",GMRADDT)) Q:GMRADDT<1 D Q:GMRAOUT 46 .S GMRACA="" 47 .F S GMRACA=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA)) Q:GMRACA="" D Q:GMRAOUT 48 ..S GMRAPA1=0 49 ..F S GMRAPA1=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT 50 ...S GMRAPA=$G(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)) 51 ...Q:GMRAPA="" 52 ...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) 53 ...Q:GMRAPA1(0)="" 54 ...S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 55 ...Q:GMRAPA(0)="" 56 ...D HEAD Q:GMRAOUT 57 ...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date 58 ...W ?8,"|",GMRACA ; Causative Agent 59 ...W ?38,"|" 60 ...S GMRAREC=0 61 ...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC) 62 ...W ?58,"| " W $P(GMRAPA(0),U,14) ; Mechanism 63 ...W ?63,"|" W $S($P(GMRAPA1(0),U,14)=1:"MILD",$P(GMRAPA1(0),U,14)=2:"MOD.",$P(GMRAPA1(0),U,14)=3:"SVR.",1:"") ; Severity 64 ...W ?68,"|" 65 ...K ^TMP($J,"GMRAWORD") D WORD^GMRAWORD(GMRAPA,"OVE",60) 66 ...S GMRACNT=1 W $G(^TMP($J,"GMRAWORD",GMRACNT)) 67 ...F S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1 D SIGN("1",GMRAREC) Q:GMRAOUT 68 ...F S GMRACNT=$O(^TMP($J,"GMRAWORD",GMRACNT)) Q:GMRACNT<1 D Q:GMRAOUT 69 ....D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|" 70 ....Q:GMRAOUT 71 ....W $G(^TMP($J,"GMRAWORD",GMRACNT)) 72 ....Q 73 ...K ^TMP($J,"GMRAWORD") 74 ...Q:GMRAOUT 75 ...D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|" 76 ...Q 77 ..Q 78 .Q 79 D CLOSE^GMRAUTL 80 Q 81 SIGN(CNT,GMRAREC) ; Print Sign/Symptoms 82 N NAM,Y 83 S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0)) 84 S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"") 85 I 'CNT W $E(NAM,1,19) 86 E D 87 .D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|" 88 .I $D(^TMP($J,"GMRAWORD",(GMRACNT+1))) S GMRACNT=GMRACNT+1 W $G(^TMP($J,"GMRAWORD",GMRACNT)) 89 .Q 90 Q 91 HEAD ; Print header information 92 I GMRAPG'=1 Q:$Y<(IOSL-4) 93 I $E(IOST,1)="C" D Q:GMRAOUT 94 .I GMRAPG=1 W @IOF Q 95 .I GMRAPG'=1 D Q:GMRAOUT 96 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 97 ..K Y 98 ..Q 99 .Q 100 Q:GMRAOUT 101 I GMRAPG'=1 W @IOF 102 N Z 103 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?125,"Page: ",GMRAPG 104 W !,?48,"P&T Committee ADR Report" 105 W !,?51,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 106 W !,$$REPEAT^XLFSTR("-",130) 107 W !,"Obsv.",?8,"|",?38,"|",?58,"|ADR",?63,"|ADR",?68,"|" 108 W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Mech",?63,"|Svr.",?68,"|Comments" 109 W !,$$REPEAT^XLFSTR("-",130) 110 S GMRAPG=GMRAPG+1 111 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 112 Q 1 GMRAPST7 ;HIRMFO/WAA- ADVERSE DRUG REACTION REPORT ;3/5/97 15:17 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 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,"GMRAPST7") 12 Q 13 PRINTER ;Select printer 14 W !!,"This report required a 132 column printer." 15 K GMRAZIS S GMRAZIS="M132" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 16 I $D(IO("Q")) D Q 17 . S ZTRTN="PRINT^GMRAPST7",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 18 . S ZTDESC="P&T Committee ADR Report" D ^%ZTLOAD 19 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 20 . Q 21 U IO D PRINT U IO(0) 22 Q 23 PRINT ;Queue point for report 24 ;loop through the 120.85 file and look for the field that 25 K ^TMP($J,"GMRAPST7") 26 D NOW^%DTC S GMRADPDT=X 27 S GMRADATE=GMAST-.0001,GMRAPG=1 28 F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D 29 .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D 30 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node 31 ..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date 32 ..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85 33 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" ; Bad node 34 ..Q:+$G(^GMR(120.8,GMRAPA,"ER")) ;Entered in error data 35 ..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent 36 ..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) 37 ..S ^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)=GMRAPA 38 ..Q 39 .Q 40 Q:GMRAOUT 41 I '$D(^TMP($J,"GMRAPST7")) 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,"GMRAPST7",GMRADDT)) Q:GMRADDT<1 D Q:GMRAOUT 45 .S GMRACA="" 46 .F S GMRACA=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA)) Q:GMRACA="" D Q:GMRAOUT 47 ..S GMRAPA1=0 48 ..F S GMRAPA1=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT 49 ...S GMRAPA=$G(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)) 50 ...Q:GMRAPA="" 51 ...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) 52 ...Q:GMRAPA1(0)="" 53 ...S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 54 ...Q:GMRAPA(0)="" 55 ...D HEAD Q:GMRAOUT 56 ...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date 57 ...W ?8,"|",GMRACA ; Causative Agent 58 ...W ?38,"|" 59 ...S GMRAREC=0 60 ...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC) 61 ...W ?58,"| " W $P(GMRAPA(0),U,14) ; Mechanism 62 ...W ?63,"|" W $S($P(GMRAPA1(0),U,14)=1:"MILD",$P(GMRAPA1(0),U,14)=2:"MOD.",$P(GMRAPA1(0),U,14)=3:"SVR.",1:"") ; Severity 63 ...W ?68,"|" 64 ...K ^TMP($J,"GMRAWORD") D WORD^GMRAWORD(GMRAPA,"OVE",60) 65 ...S GMRACNT=1 W $G(^TMP($J,"GMRAWORD",GMRACNT)) 66 ...F S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1 D SIGN("1",GMRAREC) Q:GMRAOUT 67 ...F S GMRACNT=$O(^TMP($J,"GMRAWORD",GMRACNT)) Q:GMRACNT<1 D Q:GMRAOUT 68 ....D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|" 69 ....Q:GMRAOUT 70 ....W $G(^TMP($J,"GMRAWORD",GMRACNT)) 71 ....Q 72 ...K ^TMP($J,"GMRAWORD") 73 ...Q:GMRAOUT 74 ...D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|" 75 ...Q 76 ..Q 77 .Q 78 D CLOSE^GMRAUTL 79 Q 80 SIGN(CNT,GMRAREC) ; Print Sign/Symptoms 81 N NAM,Y 82 S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0)) 83 S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"") 84 I 'CNT W $E(NAM,1,19) 85 E D 86 .D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|" 87 .I $D(^TMP($J,"GMRAWORD",(GMRACNT+1))) S GMRACNT=GMRACNT+1 W $G(^TMP($J,"GMRAWORD",GMRACNT)) 88 .Q 89 Q 90 HEAD ; Print header information 91 I GMRAPG'=1 Q:$Y<(IOSL-4) 92 I $E(IOST,1)="C" D Q:GMRAOUT 93 .I GMRAPG=1 W @IOF Q 94 .I GMRAPG'=1 D Q:GMRAOUT 95 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 96 ..K Y 97 ..Q 98 .Q 99 Q:GMRAOUT 100 I GMRAPG'=1 W @IOF 101 N Z 102 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?125,"Page: ",GMRAPG 103 W !,?48,"P&T Committee ADR Report" 104 W !,?51,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 105 W !,$$REPEAT^XLFSTR("-",130) 106 W !,"Obsv.",?8,"|",?38,"|",?58,"|ADR",?63,"|ADR",?68,"|" 107 W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Mech",?63,"|Svr.",?68,"|Comments" 108 W !,$$REPEAT^XLFSTR("-",130) 109 S GMRAPG=GMRAPG+1 110 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 111 Q
Note:
See TracChangeset
for help on using the changeset viewer.
