Changeset 623 for WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- Location:
- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA
- Files:
-
- 19 edited
-
GMRACMR4.m (modified) (1 diff)
-
GMRADSP5.m (modified) (1 diff)
-
GMRAEF2.m (modified) (1 diff)
-
GMRAFDA3.m (modified) (1 diff)
-
GMRAGUI1.m (modified) (1 diff)
-
GMRAPET0.m (modified) (1 diff)
-
GMRAPFT.m (modified) (1 diff)
-
GMRAPL.m (modified) (1 diff)
-
GMRAPNA.m (modified) (1 diff)
-
GMRAPST1.m (modified) (1 diff)
-
GMRAPST2.m (modified) (1 diff)
-
GMRAPST3.m (modified) (1 diff)
-
GMRAPST4.m (modified) (1 diff)
-
GMRAPST5.m (modified) (1 diff)
-
GMRAPST6.m (modified) (1 diff)
-
GMRAPST7.m (modified) (1 diff)
-
GMRAPU.m (modified) (1 diff)
-
GMRAUTL1.m (modified) (1 diff)
-
GMRAVFY.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRACMR4.m
r613 r623 1 GMRACMR4 ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;10/1/92 2 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5 3 EN1 ;This is the main entry point for this program 4 D EN1^GMRACMR G:GMRAOUT EXIT 5 DEV ; *** Select output device, force queuing 6 S GMRAZIS="" 7 S:GMRASEL'="1," GMRAZIS="Q" 8 W !! D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT 9 I $D(IO("Q")) D G EXIT 10 . K IO("Q") 11 . S ZTRTN="ENTSK^GMRACMR4" 12 . S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")="" 13 . S ZTDESC="List of patients without ID band or Chart marked" 14 . D ^%ZTLOAD 15 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...") 16 . Q 17 E D ENTSK 18 Q 19 ENTSK U IO 20 D EN1^GMRACMR2,EN1^GMRACMR3 21 S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y) 22 D SITE^GMRAUTL S GMRASITE=$G(^GMRD(120.84,GMRASITE,0)) 23 D PRINT 24 G EXIT 25 PRINT ;PRINT THE DATE 26 D PRE^GMRAPNA 27 S GMRAHLOC="" F S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC="" S GMRAX=0 Q:GMRAOUT F S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1 D Q:GMRAOUT 28 .S GMRA=^TMP($J,"GMRAWC",GMRAX) 29 .D HEAD Q:GMRAOUT 30 .W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U) 31 .S GMRACNT=0 32 .S GMRADATE=0 F S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE)) Q:GMRADATE="" S (GMRAFLG,GMRADFN)=0 F S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1 D Q:GMRAOUT 33 ..Q:'$$PRDTST^GMRAUTL1(GMRADFN) ;GMRA*4*33 Exclude test patient from report if production or legacy environment. 34 ..S GMRAI=0 F S GMRAI=$O(^GMR(120.8,"B",GMRADFN,GMRAI)) Q:GMRAI<1 D Q:GMRAOUT 35 ...Q:'$D(^GMR(120.8,GMRAI,0)) Q:$P($G(^GMR(120.86,GMRADFN,0)),U,2)'=1 36 ...Q:$D(^GMR(120.8,GMRAI,"ER")) 37 ...Q:$P(^GMR(120.8,GMRAI,0),U,2)="" 38 ...S (GMRA("C"),GMRA("I"),GMRA("M"))=1 39 ...I '$O(^GMR(120.8,GMRAI,13,0)) S (GMRA("C"),GMRA("M"))=0 40 ...I GMRA'="W",GMRA("M") Q 41 ...I GMRA="W",$P(GMRASITE,U,5)'=0,'$$IDMARK^GMRACMR5(GMRADFN,GMRADATE,GMRAI) S (GMRA("I"),GMRA("M"))=0 42 ...I GMRA("M") Q 43 ...S GMRACNT=GMRACNT+1 44 ...W ! I GMRAFLG'=GMRADFN W $E($P(^DPT(GMRADFN,0),U),1,30) S (DFN,GMRAFLG)=GMRADFN S GMRAPID="" D VAD^GMRAUTL1(GMRADFN,"","","","","","","",.GMRAPID) W ?30,GMRAPID K GMRAPID 45 ...W ?45,$E($P(^GMR(120.8,GMRAI,0),U,2),1,20) 46 ...I GMRA="W" W ?66,$S(('GMRA("C")&'GMRA("I")):"ID BAND/CHART",('GMRA("C")):"CHART",('GMRA("I")):"ID BAND",1:"ERROR") 47 ...E W ?66,$S('GMRA("C"):"CHART",1:"ERROR") 48 ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT 49 ...Q 50 ..Q 51 .D NOPAT^GMRAPNA 52 .Q 53 D CLOSE^GMRAUTL 54 Q 55 HEAD ;HEADER PAGE FOR PRINTOUT 56 S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF 57 I $E(IOST,1)="C",GMRAPAGE'=1 D Q:GMRAOUT 58 .S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 59 .K Y 60 .Q 61 W:GMRAPAGE'=1 @IOF 62 W !,GMRAPDT,?22,"PATIENTS WITH UNMARKED ID BAND/CHART",?70,"PAGE ",GMRAPAGE 63 I GMRASEL["1" S GMRATL="CURRENT INPATIENTS" 64 I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS") 65 I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS") 66 W !,?(40-($L(GMRATL)/2)),GMRATL 67 I (GMRASEL["2"!(GMRASEL["3")) W !,?22,"FROM ",$$DATE^GMRAUTL1(GMRAST),?43,"TO ",$$DATE^GMRAUTL1(GMRAED) 68 W !!,"PATIENT",?30,"SSN",?45,"ALLERGY",?66,"UNMARKED" 69 W !,$$REPEAT^XLFSTR("-",79) 70 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 71 Q 72 EXIT ; 73 K ^TMP($J,"GMRAWC") 74 D KILL^XUSCLEAN 75 Q 1 GMRACMR4 ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ; 10/1/92 2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 3 EN1 ;This is the main entry point for this program 4 D EN1^GMRACMR G:GMRAOUT EXIT 5 DEV ; *** Select output device, force queueing 6 S GMRAZIS="" 7 S:GMRASEL'="1," GMRAZIS="Q" 8 W !! D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT 9 I $D(IO("Q")) D G EXIT 10 . K IO("Q") 11 . S ZTRTN="ENTSK^GMRACMR4" 12 . S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")="" 13 . S ZTDESC="List of patients without ID band or Chart marked" 14 . D ^%ZTLOAD 15 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...") 16 . Q 17 E D ENTSK 18 Q 19 ENTSK U IO 20 D EN1^GMRACMR2,EN1^GMRACMR3 21 S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y) 22 D SITE^GMRAUTL S GMRASITE=$G(^GMRD(120.84,GMRASITE,0)) 23 D PRINT 24 G EXIT 25 PRINT ;PRINT THE DATE 26 D PRE^GMRAPNA 27 S GMRAHLOC="" F S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC="" S GMRAX=0 Q:GMRAOUT F S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1 D Q:GMRAOUT 28 .S GMRA=^TMP($J,"GMRAWC",GMRAX) 29 .D HEAD Q:GMRAOUT 30 .W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U) 31 .S GMRACNT=0 32 .S GMRADATE=0 F S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE)) Q:GMRADATE="" S (GMRAFLG,GMRADFN)=0 F S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1 D Q:GMRAOUT 33 ..S GMRAI=0 F S GMRAI=$O(^GMR(120.8,"B",GMRADFN,GMRAI)) Q:GMRAI<1 D Q:GMRAOUT 34 ...Q:'$D(^GMR(120.8,GMRAI,0)) Q:$P($G(^GMR(120.86,GMRADFN,0)),U,2)'=1 35 ...Q:$D(^GMR(120.8,GMRAI,"ER")) 36 ...Q:$P(^GMR(120.8,GMRAI,0),U,2)="" 37 ...S (GMRA("C"),GMRA("I"),GMRA("M"))=1 38 ...I '$O(^GMR(120.8,GMRAI,13,0)) S (GMRA("C"),GMRA("M"))=0 39 ...I GMRA'="W",GMRA("M") Q 40 ...I GMRA="W",$P(GMRASITE,U,5)'=0,'$$IDMARK^GMRACMR5(GMRADFN,GMRADATE,GMRAI) S (GMRA("I"),GMRA("M"))=0 41 ...I GMRA("M") Q 42 ...S GMRACNT=GMRACNT+1 43 ...W ! I GMRAFLG'=GMRADFN W $E($P(^DPT(GMRADFN,0),U),1,30) S (DFN,GMRAFLG)=GMRADFN S GMRAPID="" D VAD^GMRAUTL1(GMRADFN,"","","","","","","",.GMRAPID) W ?30,GMRAPID K GMRAPID 44 ...W ?45,$E($P(^GMR(120.8,GMRAI,0),U,2),1,20) 45 ...I GMRA="W" W ?66,$S(('GMRA("C")&'GMRA("I")):"ID BAND/CHART",('GMRA("C")):"CHART",('GMRA("I")):"ID BAND",1:"ERROR") 46 ...E W ?66,$S('GMRA("C"):"CHART",1:"ERROR") 47 ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT 48 ...Q 49 ..Q 50 .D NOPAT^GMRAPNA 51 .Q 52 D CLOSE^GMRAUTL 53 Q 54 HEAD ;HEADER PAGE FOR PRINTOUT 55 S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF 56 I $E(IOST,1)="C",GMRAPAGE'=1 D Q:GMRAOUT 57 .S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 58 .K Y 59 .Q 60 W:GMRAPAGE'=1 @IOF 61 W !,GMRAPDT,?22,"PATIENTS WITH UNMARKED ID BAND/CHART",?70,"PAGE ",GMRAPAGE 62 I GMRASEL["1" S GMRATL="CURRENT INPATIENTS" 63 I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS") 64 I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS") 65 W !,?(40-($L(GMRATL)/2)),GMRATL 66 I (GMRASEL["2"!(GMRASEL["3")) W !,?22,"FROM ",$$DATE^GMRAUTL1(GMRAST),?43,"TO ",$$DATE^GMRAUTL1(GMRAED) 67 W !!,"PATIENT",?30,"SSN",?45,"ALLERGY",?66,"UNMARKED" 68 W !,$$REPEAT^XLFSTR("-",79) 69 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 70 Q 71 EXIT ; 72 K ^TMP($J,"GMRAWC") 73 D KILL^XUSCLEAN 74 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP5.m
r613 r623 1 GMRADSP5 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ;8/16/92 2 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5 3 EN1 ; Entry to PATIENT ALLERGIES NOT SIGNED OFF option 4 S GMRAOUT=0 5 S GMRAHEAD(1)=$J("ALLERGY/ADVERSE REACTIONS TO BE SIGNED OFF",59),GMRAHEAD(4)=$J("ORIGINATOR",10)_$J("PATIENT",21)_$J("ALLERGY",19)_$J("ORIGINATION DATE/TIME",29),(GMRAHEAD(3),GMRAHEAD(5),GMRAHEAD(6))="",$P(GMRAHEAD(5),"-",81)="" 6 S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P") 7 S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55) 8 K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT 9 I $D(IO("Q")) D TASK G EXIT 10 EN2 S (GMRAORG,GMRADT)="" 11 F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"ASGN",GMRAREC)) Q:GMRAREC'>0 D EN2A 12 G DISP 13 Q 14 EN2A S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:GMRATEMP="" 15 I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q:$P(GMRATEMP,U,5)'=DUZ 16 Q:'$$PRDTST^GMRAUTL1($P(GMRATEMP,U)) ;GMRA*4*33 Exclude test patient if production or legacy environment. 17 S DFN=$P(GMRATEMP,U) D PID^VADPT6 S GMRASSN=VA("BID") D KVA^VADPT 18 I $P(GMRATEMP,U,5)'="" S ^TMP($J,"GMRADSP",$P(^VA(200,$P(GMRATEMP,U,5),0),U),$P(GMRATEMP,U,5),$P(GMRATEMP,U,4),$P(GMRATEMP,U),GMRAREC)=$P(GMRATEMP,U,2)_U_$E($P(^DPT($P(GMRATEMP,U),0),U),1,14)_"("_GMRASSN_")" 19 Q 20 DISP S GMRAPG=0 D HDR^GMRADSP3 W:'$D(^TMP($J,"GMRADSP")) !!!,?7,"NO DATA FOR THIS REPORT" 21 S GMRAORG="" F S GMRAORG=$O(^TMP($J,"GMRADSP",GMRAORG)) Q:GMRAORG=""!GMRAOUT D Q:GMRAOUT 22 .S GMRAIEN="" F S GMRAIEN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN)) Q:GMRAIEN=""!GMRAOUT D Q:GMRAOUT 23 ..S GMRADT="" F S GMRADT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT)) Q:GMRADT=""!GMRAOUT D Q:GMRAOUT 24 ...S GMRADFN="" F S GMRADFN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN)) Q:GMRADFN=""!GMRAOUT D EN3 25 ...Q 26 ..Q 27 .Q 28 EXIT ;Quit and kill 29 D CLOSE^GMRAUTL 30 K ^TMP($J,"GMRADSP"),X,Y,Z 31 D KILL^XUSCLEAN 32 Q 33 EN3 S GMRAPAT="" F S GMRAPAT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN,GMRAPAT)) Q:GMRAPAT=""!GMRAOUT S GMRALL=$G(^(GMRAPAT)) I GMRALL'="" D Q:GMRAOUT 34 .S Y=GMRADT D D^DIQ W !,$E(GMRAORG,1,15),?17,$P(GMRALL,U,2),?42,$E($P(GMRALL,U),1,16),?59,Y 35 .D:IOSL-4<$Y EOP^GMRADSP3 Q:GMRAOUT 36 .Q 37 Q 38 TASK ; 39 S ZTDESC="Patient reactions not signed off",ZTRTN="EN2^GMRADSP5",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD 40 W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...") 41 K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK 42 Q 1 GMRADSP5 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ; 8/16/92 2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 3 EN1 ; Entry to PATIENT ALLERGIES NOT SIGNED OFF option 4 S GMRAOUT=0 5 S GMRAHEAD(1)=$J("ALLERGY/ADVERSE REACTIONS TO BE SIGNED OFF",59),GMRAHEAD(4)=$J("ORIGINATOR",10)_$J("PATIENT",21)_$J("ALLERGY",19)_$J("ORIGINATION DATE/TIME",29),(GMRAHEAD(3),GMRAHEAD(5),GMRAHEAD(6))="",$P(GMRAHEAD(5),"-",81)="" 6 S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P") 7 S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55) 8 K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT 9 I $D(IO("Q")) D TASK G EXIT 10 EN2 S (GMRAORG,GMRADT)="" 11 F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"ASGN",GMRAREC)) Q:GMRAREC'>0 D EN2A 12 G DISP 13 Q 14 EN2A S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:GMRATEMP="" 15 I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q:$P(GMRATEMP,U,5)'=DUZ 16 S DFN=$P(GMRATEMP,U) D PID^VADPT6 S GMRASSN=VA("BID") D KVA^VADPT 17 I $P(GMRATEMP,U,5)'="" S ^TMP($J,"GMRADSP",$P(^VA(200,$P(GMRATEMP,U,5),0),U),$P(GMRATEMP,U,5),$P(GMRATEMP,U,4),$P(GMRATEMP,U),GMRAREC)=$P(GMRATEMP,U,2)_U_$E($P(^DPT($P(GMRATEMP,U),0),U),1,14)_"("_GMRASSN_")" 18 Q 19 DISP S GMRAPG=0 D HDR^GMRADSP3 W:'$D(^TMP($J,"GMRADSP")) !!!,?7,"NO DATA FOR THIS REPORT" 20 S GMRAORG="" F S GMRAORG=$O(^TMP($J,"GMRADSP",GMRAORG)) Q:GMRAORG=""!GMRAOUT D Q:GMRAOUT 21 .S GMRAIEN="" F S GMRAIEN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN)) Q:GMRAIEN=""!GMRAOUT D Q:GMRAOUT 22 ..S GMRADT="" F S GMRADT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT)) Q:GMRADT=""!GMRAOUT D Q:GMRAOUT 23 ...S GMRADFN="" F S GMRADFN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN)) Q:GMRADFN=""!GMRAOUT D EN3 24 ...Q 25 ..Q 26 .Q 27 EXIT ;Quit and kill 28 D CLOSE^GMRAUTL 29 K ^TMP($J,"GMRADSP"),X,Y,Z 30 D KILL^XUSCLEAN 31 Q 32 EN3 S GMRAPAT="" F S GMRAPAT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN,GMRAPAT)) Q:GMRAPAT=""!GMRAOUT S GMRALL=$G(^(GMRAPAT)) I GMRALL'="" D Q:GMRAOUT 33 .S Y=GMRADT D D^DIQ W !,$E(GMRAORG,1,15),?17,$P(GMRALL,U,2),?42,$E($P(GMRALL,U),1,16),?59,Y 34 .D:IOSL-4<$Y EOP^GMRADSP3 Q:GMRAOUT 35 .Q 36 Q 37 TASK ; 38 S ZTDESC="Patient reactions not signed off",ZTRTN="EN2^GMRADSP5",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD 39 W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...") 40 K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK 41 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAEF2.m
r613 r623 1 GMRAEF2 ;HIRMFO/WAA-FDA EXCEPTION REPORT ;11/29/95 15:01 2 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5 3 EN1 ; Entry to PRINT ALL FDA EXCEPTIONS WITHIN A D/T RANGE option 4 S GMRAOUT=0 K DIR 5 S DIR(0)="DO^:DT:ETX",DIR("A")="Select Start Date" 6 D ^DIR K DIR 7 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT 8 S (GMRABGDT,GMRASTDT)=Y K Y 9 S DIR(0)="DO^"_GMRABGDT_":NOW:ETX",DIR("A")="Select End Date",DIR("B")="T" 10 D ^DIR K DIR 11 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT 12 S GMRAEDT=Y,GMRAENDT=((Y+1)-.0000001) K Y 13 EN2 ; 14 S GMRABGDT=GMRABGDT-.0000001 15 F S GMRABGDT=$O(^GMR(120.8,"AODT",GMRABGDT)) Q:GMRABGDT<1 Q:GMRABGDT>GMRAENDT S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,"AODT",GMRABGDT,GMRAIEN)) Q:GMRAIEN<1 D 16 .S GMRA(0)=$G(^GMR(120.8,GMRAIEN,0)) 17 .Q:$P(GMRA(0),U,2)="" 18 .Q:$D(^GMR(120.8,GMRAIEN,"ER")) 19 .I $P(GMRA(0),U,6)'="o"!($P(GMRA(0),U,20)'["D") Q 20 .I '$P(GMRA(0),U,12) Q 21 .I $$CMPFDA^GMRAEF1(GMRAIEN) Q 22 .S GMRDFN=$P(GMRA(0),U) 23 .Q:'$$PRDTST^GMRAUTL1(GMRDFN) ;GMRA*4*33 Exclude test patient from report if production or legacy environment. 24 .S ^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN 25 .Q 26 D EN1^GMRAEF 27 EXIT ;EXIT OF ROUTINE 28 K GMRAY,GMRAX,GMRAIEN,GMRDFN,GMRBGDT,GMRENDT,GMRDT,GMRAOUT 29 K GMRA,GMRABGDT,GMRAENDT 30 Q 1 GMRAEF2 ;HIRMFO/WAA-FDA EXCEPTION REPORT ;11/29/95 15:01 2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 3 EN1 ; Entry to PRINT ALL FDA EXCEPTIONS WITHIN A D/T RANGE option 4 S GMRAOUT=0 K DIR 5 S DIR(0)="DO^:DT:ETX",DIR("A")="Select Start Date" 6 D ^DIR K DIR 7 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT 8 S (GMRABGDT,GMRASTDT)=Y K Y 9 S DIR(0)="DO^"_GMRABGDT_":NOW:ETX",DIR("A")="Select End Date",DIR("B")="T" 10 D ^DIR K DIR 11 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT 12 S GMRAEDT=Y,GMRAENDT=((Y+1)-.0000001) K Y 13 EN2 ; 14 S GMRABGDT=GMRABGDT-.0000001 15 F S GMRABGDT=$O(^GMR(120.8,"AODT",GMRABGDT)) Q:GMRABGDT<1 Q:GMRABGDT>GMRAENDT S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,"AODT",GMRABGDT,GMRAIEN)) Q:GMRAIEN<1 D 16 .S GMRA(0)=$G(^GMR(120.8,GMRAIEN,0)) 17 .Q:$P(GMRA(0),U,2)="" 18 .Q:$D(^GMR(120.8,GMRAIEN,"ER")) 19 .I $P(GMRA(0),U,6)'="o"!($P(GMRA(0),U,20)'["D") Q 20 .I '$P(GMRA(0),U,12) Q 21 .I $$CMPFDA^GMRAEF1(GMRAIEN) Q 22 .S GMRDFN=$P(GMRA(0),U) 23 .S ^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN 24 .Q 25 D EN1^GMRAEF 26 EXIT ;EXIT OF ROUTINE 27 K GMRAY,GMRAX,GMRAIEN,GMRDFN,GMRBGDT,GMRENDT,GMRDT,GMRAOUT 28 K GMRA,GMRABGDT,GMRAENDT 29 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAFDA3.m
r613 r623 1 GMRAFDA3 ;HIRMFO/WAA-DISPLAY FDA REPORT OVER DT RANGE ;12/1/95 11:34 2 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5 3 EN1 ; Entry for PRINT ALL FDA EVENTS WITHIN D/T RANGE option 4 S GMRAOUT=0 K DIR 5 S DIR(0)="DO^:NOW:EXT",DIR("A")="Select Start Date/Time" 6 D ^DIR K DIR 7 I $D(DIRUT) G EXIT 8 S GMRABGDT=Y K Y 9 S DIR(0)="DO^"_GMRABGDT_":NOW:EXT",DIR("A")="Select End Date/Time",DIR("B")="T" 10 D ^DIR K DIR 11 I $D(DIRUT) G EXIT 12 S GMRAENDT=Y K Y 13 EN2 ; 14 S GMRABGDT=GMRABGDT-.0000001 15 S GMRAENDT=$S($P(GMRAENDT,".",2)="":GMRAENDT_".24",1:(GMRAENDT+.000001)) 16 YN F S %=1 W !,"Do you want an Abbreviated report" D YN^DICN S:%=-1 %=2,GMRAOUT=1 Q:% W !,"ENTER ""Y"" FOR YES OR ""N"" FOR NO",$C(7) 17 G:GMRAOUT EXIT 18 S GMRAYN=% 19 PRINTER ;Select printer 20 S GMRAOUT=0,GMRAPG=0 21 W ! K GMRAZIS S:GMRAYN=2 GMRAZIS="QM132S60" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" G EXIT 22 I $D(IO("Q")) D G EXIT 23 .S ZTRTN="PRINT^GMRAFDA3",ZTSAVE("GMRAPG")="",ZTSAVE("GMRAOUT")="",ZTSAVE("GMRABGDT")="",ZTSAVE("GMRAENDT")="",ZTSAVE("GMRAYN")="" 24 .S ZTDESC="Print FDA Report by Date/Time" D ^%ZTLOAD 25 .W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...") 26 .Q 27 U IO D PRINT U IO(0) 28 D CLOSE^GMRAUTL 29 G EXIT 30 Q 31 PRINT ;Central Print 32 N GMRACNT S GMRACNT=0 33 S GMRAFLG=0,GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"1") 34 I IOST?1"C".E W @IOF 35 I GMRAYN=1 D HDR1 36 F S GMRABGDT=$O(^GMR(120.85,"B",GMRABGDT)) Q:GMRABGDT<1!(GMRABGDT>GMRAENDT)!(GMRAOUT) S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRABGDT,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT 37 .I +$P($G(^GMR(120.8,+$P($G(^GMR(120.85,+GMRAPA1,0)),U,15),"ER")),U,1)=1 Q 38 .I GMRAYN=2 D PRT^GMRAFDA1 Q 39 .I $Y>(IOSL-3) D HEAD Q:GMRAOUT 40 .S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" 41 .S GMRAPA(0)=$G(^GMR(120.8,$P(GMRAPA1(0),U,15),0)) Q:GMRAPA(0)="" 42 .S DFN=$P(GMRAPA(0),U) D PID^VADPT6 43 .Q:'$$PRDTST^GMRAUTL1(DFN) ;GMRA*4*33 Exclude test patient from report if production or legacy environment. 44 .S GMRACNT=GMRACNT+1 45 .W !,$E($P(^DPT(DFN,0),U),1,23)," (",VA("PID"),")" K VA,DFN 46 .W ?32,$E($P(GMRAPA(0),U,2),1,28) 47 .W ?62 S Y=$P(GMRAPA1(0),U),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2) K Y 48 .I $P($G(^GMR(120.85,GMRAPA1,"PTC1")),U,5) D 49 ..W !,?5,"(SENT TO FDA: " S Y=$P(^GMR(120.85,GMRAPA1,"PTC1"),U,5),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2),")" K Y 50 .Q 51 .K GMRAPA1(0),GMRAPA(0) 52 .Q 53 I 'GMRACNT W !,?30,"NO DATA FOR THIS REPORT" 54 Q 55 HEAD ;Header Print 56 HDR ; 57 I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR K DIR I Y'>0 S GMRAOUT=1 Q 58 W @IOF 59 HDR1 S GMRAPG=GMRAPG+1 60 W GMRANOW,?70,"Page: ",GMRAPG 61 W !,?30,"FDA ABBREVIATED REPORT" 62 W !,"PATIENT",?32,"SUSPECTED AGENT",?62,"D/T OF EVENT" 63 W !,$$REPEAT^XLFSTR("-",79),! 64 Q 65 EXIT ;EXIT 66 K ^TMP($J,"GMRAEF") 67 D KILL^XUSCLEAN 68 Q 1 GMRAFDA3 ;HIRMFO/WAA-DISPLAY FDA REPORT OVER DT RANGE ;12/1/95 11:34 2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 3 EN1 ; Entry for PRINT ALL FDA EVENTS WITHIN D/T RANGE option 4 S GMRAOUT=0 K DIR 5 S DIR(0)="DO^:NOW:EXT",DIR("A")="Select Start Date/Time" 6 D ^DIR K DIR 7 I $D(DIRUT) G EXIT 8 S GMRABGDT=Y K Y 9 S DIR(0)="DO^"_GMRABGDT_":NOW:EXT",DIR("A")="Select End Date/Time",DIR("B")="T" 10 D ^DIR K DIR 11 I $D(DIRUT) G EXIT 12 S GMRAENDT=Y K Y 13 EN2 ; 14 S GMRABGDT=GMRABGDT-.0000001 15 S GMRAENDT=$S($P(GMRAENDT,".",2)="":GMRAENDT_".24",1:(GMRAENDT+.000001)) 16 YN F S %=1 W !,"Do you want an Abbreviated report" D YN^DICN S:%=-1 %=2,GMRAOUT=1 Q:% W !,"ENTER ""Y"" FOR YES OR ""N"" FOR NO",$C(7) 17 G:GMRAOUT EXIT 18 S GMRAYN=% 19 PRINTER ;Select printer 20 S GMRAOUT=0,GMRAPG=0 21 W ! K GMRAZIS S:GMRAYN=2 GMRAZIS="QM132S60" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" G EXIT 22 I $D(IO("Q")) D G EXIT 23 .S ZTRTN="PRINT^GMRAFDA3",ZTSAVE("GMRAPG")="",ZTSAVE("GMRAOUT")="",ZTSAVE("GMRABGDT")="",ZTSAVE("GMRAENDT")="",ZTSAVE("GMRAYN")="" 24 .S ZTDESC="Print FDA Report by Date/Time" D ^%ZTLOAD 25 .W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...") 26 .Q 27 U IO D PRINT U IO(0) 28 D CLOSE^GMRAUTL 29 G EXIT 30 Q 31 PRINT ;Central Print 32 N GMRACNT S GMRACNT=0 33 S GMRAFLG=0,GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"1") 34 I IOST?1"C".E W @IOF 35 I GMRAYN=1 D HDR1 36 F S GMRABGDT=$O(^GMR(120.85,"B",GMRABGDT)) Q:GMRABGDT<1!(GMRABGDT>GMRAENDT)!(GMRAOUT) S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRABGDT,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT 37 .I +$P($G(^GMR(120.8,+$P($G(^GMR(120.85,+GMRAPA1,0)),U,15),"ER")),U,1)=1 Q 38 .I GMRAYN=2 D PRT^GMRAFDA1 Q 39 .I $Y>(IOSL-3) D HEAD Q:GMRAOUT 40 .S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" 41 .S GMRAPA(0)=$G(^GMR(120.8,$P(GMRAPA1(0),U,15),0)) Q:GMRAPA(0)="" 42 .S DFN=$P(GMRAPA(0),U) D PID^VADPT6 43 .S GMRACNT=GMRACNT+1 44 .W !,$E($P(^DPT(DFN,0),U),1,23)," (",VA("PID"),")" K VA,DFN 45 .W ?32,$E($P(GMRAPA(0),U,2),1,28) 46 .W ?62 S Y=$P(GMRAPA1(0),U),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2) K Y 47 .I $P($G(^GMR(120.85,GMRAPA1,"PTC1")),U,5) D 48 ..W !,?5,"(SENT TO FDA: " S Y=$P(^GMR(120.85,GMRAPA1,"PTC1"),U,5),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2),")" K Y 49 .Q 50 .K GMRAPA1(0),GMRAPA(0) 51 .Q 52 I 'GMRACNT W !,?30,"NO DATA FOR THIS REPORT" 53 Q 54 HEAD ;Header Print 55 HDR ; 56 I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR K DIR I Y'>0 S GMRAOUT=1 Q 57 W @IOF 58 HDR1 S GMRAPG=GMRAPG+1 59 W GMRANOW,?70,"Page: ",GMRAPG 60 W !,?30,"FDA ABBREVIATED REPORT" 61 W !,"PATIENT",?32,"SUSPECTED AGENT",?62,"D/T OF EVENT" 62 W !,$$REPEAT^XLFSTR("-",79),! 63 Q 64 EXIT ;EXIT 65 K ^TMP($J,"GMRAEF") 66 D KILL^XUSCLEAN 67 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAGUI1.m
r613 r623 1 GMRAGUI1 ;SLC/DAN - CPRS GUI support ;11/17/06 09:50 2 ;;4.0;Adverse Reaction Tracking;**21,25,36,38**;Mar 29, 1996;Build 2 3 ; 4 Q 5 EN1 ; GETREC, cont'd 6 OBSV ; Get OBSERVATIONS from file 120.85 7 S STRING="~OBSERVATIONS" D NEXT 8 S OBSIEN=0 9 OBSLOOP S OBSIEN=$O(^GMR(120.85,"C",GMRAIEN,OBSIEN)) G:OBSIEN<1 EXIT 10 S GMRA(1)=$G(^GMR(120.85,OBSIEN,0)) Q:'$L(GMRA(1)) 11 S STRING="tRecord : "_OBSIEN D NEXT 12 S USRNAM="" 13 S USR=$P(GMRA(1),U,13) I USR'="" D GETUSR 14 S Y=$P(GMRA(1),U,1) X ^DD("DD") 15 S STRING="tDate/Time of Event: "_Y D NEXT 16 S STRING="tObserver : "_USRNAM D NEXT 17 S SEVCOD=$P(GMRA(1),U,14) 18 S SEVER=$S(SEVCOD=1:"MILD",SEVCOD=2:"MODERATE",SEVCOD=3:"SEVERE",1:"") 19 S STRING="tSeverity : "_SEVER D NEXT 20 S Y=$P(GMRA(1),U,18) X ^DD("DD") 21 S STRING="tDate Reported : "_Y D NEXT 22 S USRNAM="" 23 S USR=$P(GMRA(1),U,19) I USR'="" D GETUSR 24 S STRING="tReporting User : "_USRNAM D NEXT 25 S STRING="t" F I=1:1:60 S STRING=STRING_"-" 26 D NEXT 27 G OBSLOOP 28 EXIT Q 29 NEXT ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER 30 S @GMRARRAY@(ND)=STRING,ND=ND+1,STRING="" 31 Q 32 GETUSR S USRNAM=$$GET1^DIQ(200,USR_",",".01") 33 Q 34 ; 35 EIE(GMRAIEN,GMRADFN,GMRARRAY) ;Mark individual entry as entered in error 36 N DIE,DA,DR,Y,DIK,DFN,OROLD,VAIN,X,GMRAOUT,GMRAPA 37 L +^XTMP("GMRAED",GMRADFN):1 I '$T D MESS Q 38 S GMRAPA=GMRAIEN 39 S DIE="^GMR(120.8,",DA=GMRAPA,DR="15///1;22///1;23///"_@GMRARRAY@("GMRAERRDT")_";24////"_$G(@GMRARRAY@("GMRAERRBY"),.5) ;36 40 D ^DIE ;Entered in error on date/time by user 41 I $D(@GMRARRAY@("GMRAERRCMTS")) D ADCOM(GMRAPA,"E",$NA(@GMRARRAY@("GMRAERRCMTS"))) ;add comments 42 I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D 43 .S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U) 44 .D ^DIK ;If patient's last allergy marked as entered in error then delete assessment 45 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 46 S GMRAOUT=0 47 D EN1^GMRAEAB ;Sends entered in error bulletin to appropriate mail groups 48 D EN1^GMRAPET0(GMRADFN,GMRAPA,"E",.GMRAOUT) ;21 File Progress Note 49 S DFN=GMRADFN 50 D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA ENTERED IN ERROR")_";ORD(101," 51 D:X EN^XQOR ;Process protocols hanging off of "entered in error" protocol 52 L -^XTMP("GMRAED",GMRADFN) 53 S ORY=0_$S(+$G(GMRAPN)>0:("^"_+$G(GMRAPN)),1:"") ;38 Return IEN of progress note if created 54 Q 55 ; 56 ADCOM(ENTRY,TYPE,GMRACOM) ;Add comments to allergies 57 ; 58 N FDA,GMRAI,X,DIWL,DIWR 59 K ^UTILITY($J,"W") S DIWL=1,DIWR=60 S GMRAI=0 F S GMRAI=$O(@GMRACOM@(GMRAI)) Q:'+GMRAI S X=@GMRACOM@(GMRAI) D ^DIWP 60 S GMRACOM="^UTILITY($J,""W"",1)" 61 S FDA(120.826,"+1,"_ENTRY_",",.01)=$$NOW^XLFDT 62 S FDA(120.826,"+1,"_ENTRY_",",1)=DUZ 63 S FDA(120.826,"+1,"_ENTRY_",",1.5)=TYPE 64 S FDA(120.826,"+1,"_ENTRY_",",2)=GMRACOM 65 D UPDATE^DIE("","FDA") 66 Q 67 ; 68 NKA ;Change patient assessment to NKA 69 ; 70 N DA,DR,DIE,NKA,DFN 71 S DFN=ORDFN 72 L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q 73 S NKA=$$NKA^GMRANKA(DFN) 74 I NKA=0 Q ;Patient is already NKA 75 I NKA=1 S ORY="-1^Patient has active allergies - can't mark as NKA" Q 76 L +^GMR(120.86,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q 77 I '$D(^GMR(120.86,DFN,0)) D ;Add assessment entry 78 .S $P(^GMR(120.86,0),U,3,4)=(DFN_"^"_($P(^GMR(120.86,0),U,4)+1)) 79 .S ^GMR(120.86,DFN,0)=DFN_U,^GMR(120.86,"B",DFN,DFN)="" 80 L -^GMR(120.86,0) L +^GMR(120.86,DFN,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q 81 S DIE="^GMR(120.86,",DA=DFN,DR="1////0;2////"_DUZ_";3///NOW" D ^DIE 82 S ORY=0 83 L -^XTMP("GMRAED",DFN) 84 Q 85 ; 86 UPDATE(GMRAIEN,DFN,GMRARRAY) ;Add/edit allergies 87 N NEW,NKA,FDA,NODE,IEN,SUB,FILE,DA,DIK,SIEN,GMRAS0,GMRAIEN,GMRAL,GMRAPA,GMRAAR,GMRALL,GMRADFN,GMRAOUT,GMRAROT 88 S NEW='$G(GMRAIEN) 89 I NEW,$$DUPCHK^GMRAOR0(DFN,$P(@GMRARRAY@("GMRAGNT"),U))=1 S ORY="-1^Patient already has a "_$P(@GMRARRAY@("GMRAGNT"),U)_" reaction entered. No duplicates allowed." Q 90 L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q 91 D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0)) 92 S NKA='$$NKA^GMRANKA(DFN) ;is patient NKA? 93 I NKA,NEW D 94 .S FDA(120.86,"?+"_DFN_",",.01)=DFN 95 .S FDA(120.86,"?+"_DFN_",",1)=1 96 .S FDA(120.86,"?+"_DFN_",",2)=DUZ 97 .S FDA(120.86,"?+"_DFN_",",3)=$G(@GMRARRAY@("GMRAORDT"),$$NOW^XLFDT) 98 .S IEN(DFN)=DFN 99 .D UPDATE^DIE("","FDA","IEN") 100 K FDA,IEN 101 S NODE=$S($G(NEW):"+1,",1:(GMRAIEN_",")) 102 S:$G(NEW) FDA(120.8,NODE,.01)=DFN 103 I $P($G(@GMRARRAY@("GMRAGNT")),U,2)["50.67" S $P(@GMRARRAY@("GMRAGNT"),U,2)=$$TGTOG^PSNAPIS($P(@GMRARRAY@("GMRAGNT"),U))_";PSNDF(50.6," 104 F SUB="GMRAGNT;.02","GMRATYPE;3.1","GMRANATR;17","GMRAORIG;5","GMRAORDT;4","GMRAOBHX;6" D 105 .S FDA(120.8,NODE,$P(SUB,";",2))=$P(@GMRARRAY@($P(SUB,";")),U) 106 .I (SUB["GMRAGNT"),NEW S FDA(120.8,NODE,1)=$P(@GMRARRAY@($P(SUB,";")),U,2) 107 D UPDATE^DIE("","FDA","IEN") 108 S:NEW GMRAIEN=IEN(1) 109 K FDA 110 F SUB="GMRACHT","GMRAIDBN" D 111 .Q:'$D(@GMRARRAY@(SUB)) ;Stop if no updates 112 .S FILE=$S(SUB="GMRACHT":120.813,1:120.814) 113 .S FDA(FILE,"+1,"_GMRAIEN_",",.01)=@GMRARRAY@(SUB,1) 114 .S FDA(FILE,"+1,"_GMRAIEN_",",1)=DUZ 115 .D UPDATE^DIE("","FDA") 116 I $D(@GMRARRAY@("GMRACMTS")) D ADCOM(GMRAIEN,"O",$NA(@GMRARRAY@("GMRACMTS"))) ;Add comments if included 117 K FDA 118 S SUB=0 F S SUB=$O(@GMRARRAY@("GMRASYMP",SUB)) Q:'+SUB D 119 .S GMRAS0=^(SUB) ;Naked from above 120 .Q:$P(^(SUB),U)="" ;25 No text or free text entered so don't store 121 .S SIEN=$O(^GMR(120.8,GMRAIEN,10,"B",$P(GMRAS0,U),0)) 122 .I SIEN,$P(^GMR(120.8,GMRAIEN,10,SIEN,0),U,4)=$P(GMRAS0,U,3) Q ;Exists and nothing has changed 123 .I SIEN,$P(GMRAS0,U,5)="@" S DIK="^GMR(120.8,"_GMRAIEN_",",DA(1)=GMRAIEN,DA=SIEN D ^DIK Q ;Sign/symptom deleted 124 .S:'SIEN FDA(120.81,"+1,"_GMRAIEN_",",.01)=$S($P(GMRAS0,U)="FT":$O(^GMRD(120.83,"B","OTHER REACTION",0)),1:$P(GMRAS0,U)) 125 .S NODE=$S(SIEN:SIEN_","_GMRAIEN,1:"+1,"_GMRAIEN_",") 126 .S:$P(GMRAS0,U)="FT" FDA(120.81,NODE,1)=$P(GMRAS0,U,2) 127 .S FDA(120.81,NODE,2)=DUZ 128 .S FDA(120.81,NODE,3)=$P(GMRAS0,U,3) 129 .D UPDATE^DIE("","FDA","","ERR") 130 .S GMRAROT($P(GMRAS0,U,2))="" ;21 record s/s added 131 I NEW D 132 .S GMRALL(GMRAIEN)="" D VAD^GMRAUTL1(DFN,,.GMRALOC,.GMRANAM) D EN7^GMRAMCB ;Send mark chart/ID band bulletin if needed. 133 .I $P(@GMRARRAY@("GMRAOBHX"),U)="o" D ;if observed reaction add data to 120.85 134 ..S GMRAOUT=0 ;21 135 ..S GMRAL(GMRAIEN,"O",GMRAIEN)=$G(@GMRARRAY@("GMRARDT"))_"^"_$G(@GMRARRAY@("GMRASEVR")) 136 ..S GMRADFN=DFN 137 ..S GMRAL(GMRAIEN)="^^"_$P($G(@GMRARRAY@("GMRAGNT")),U)_"^^^^"_$G(@GMRARRAY@("GMRAORIG")) 138 ..M GMRAL(GMRAIEN,"S")=@GMRARRAY@("GMRASYMP") 139 ..S SUB=0 F S SUB=$O(GMRAL(GMRAIEN,"S",SUB)) Q:'+SUB S $P(GMRAL(GMRAIEN,"S",SUB),U,2)=$P(GMRAL(GMRAIEN,"S",SUB),U,2)_"^" S:$P(GMRAL(GMRAIEN,"S",SUB),U)="FT" $P(GMRAL(GMRAIEN,"S",SUB),U)=$O(^GMRD(120.83,"B","OTHER REACTION",0)) 140 ..S GMRAL=GMRAIEN 141 ..D ADVERSE^GMRAOR7(GMRAIEN,.GMRAL) ;adds entry to 120.85 142 ..S GMRAIEN(GMRAIEN)="" ;21 143 ..D EN1^GMRAPET0(GMRADFN,.GMRAIEN,"S",.GMRAOUT) ;21 File progress note 144 ..I $G(@GMRARRAY@("GMRATYPE"))["D" S GMRAPA=GMRAIEN D EN1^GMRAPTB ;21 Send med-watch update 145 .S GMRAAR=$P($G(@GMRARRAY@("GMRAGNT")),U,2),GMRAPA=GMRAIEN 146 .D EN1^GMRAOR9 S ^TMP($J,"GMRASF",1,GMRAPA)="" D RANGE^GMRASIGN(1) ;add ingredients/classes send appropriate bulletins 147 S ORY=0_$S(+$G(GMRAPN)>0:("^"_+$G(GMRAPN)),1:"") ;38 If note was created send back IEN 148 L -^XTMP("GMRAED",DFN) 149 Q 150 ; 151 MESS ;Give out locked message 152 N GMRAXBOS,GMRAL1,GMRAL2 153 S GMRAXBOS=$$BROKER^XWBLIB ;In GUI? 154 S GMRAL1="Another user is editing this patient's allergy information." 155 S GMRAL2="Please refresh/review the patient's information before proceeding." 156 I 'GMRAXBOS W !,GMRAL1,!,GMRAL2 D WAIT^GMRAFX3 Q 157 S ORY="-1^"_GMRAL1_" "_GMRAL2 158 Q 1 GMRAGUI1 ;SLC/DAN - CPRS GUI support ;7/13/06 14:32 2 ;;4.0;Adverse Reaction Tracking;**21,25,36**;Mar 29, 1996;Build 9 3 ; 4 Q 5 EN1 ; GETREC, cont'd 6 OBSV ; Get OBSERVATIONS from file 120.85 7 S STRING="~OBSERVATIONS" D NEXT 8 S OBSIEN=0 9 OBSLOOP S OBSIEN=$O(^GMR(120.85,"C",GMRAIEN,OBSIEN)) G:OBSIEN<1 EXIT 10 S GMRA(1)=$G(^GMR(120.85,OBSIEN,0)) Q:'$L(GMRA(1)) 11 S STRING="tRecord : "_OBSIEN D NEXT 12 S USRNAM="" 13 S USR=$P(GMRA(1),U,13) I USR'="" D GETUSR 14 S Y=$P(GMRA(1),U,1) X ^DD("DD") 15 S STRING="tDate/Time of Event: "_Y D NEXT 16 S STRING="tObserver : "_USRNAM D NEXT 17 S SEVCOD=$P(GMRA(1),U,14) 18 S SEVER=$S(SEVCOD=1:"MILD",SEVCOD=2:"MODERATE",SEVCOD=3:"SEVERE",1:"") 19 S STRING="tSeverity : "_SEVER D NEXT 20 S Y=$P(GMRA(1),U,18) X ^DD("DD") 21 S STRING="tDate Reported : "_Y D NEXT 22 S USRNAM="" 23 S USR=$P(GMRA(1),U,19) I USR'="" D GETUSR 24 S STRING="tReporting User : "_USRNAM D NEXT 25 S STRING="t" F I=1:1:60 S STRING=STRING_"-" 26 D NEXT 27 G OBSLOOP 28 EXIT Q 29 NEXT ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER 30 S @GMRARRAY@(ND)=STRING,ND=ND+1,STRING="" 31 Q 32 GETUSR S USRNAM=$$GET1^DIQ(200,USR_",",".01") 33 Q 34 ; 35 EIE(GMRAIEN,GMRADFN,GMRARRAY) ;Mark individual entry as entered in error 36 N DIE,DA,DR,Y,DIK,DFN,OROLD,VAIN,X,GMRAOUT,GMRAPA 37 L +^XTMP("GMRAED",GMRADFN):1 I '$T D MESS Q 38 S GMRAPA=GMRAIEN 39 S DIE="^GMR(120.8,",DA=GMRAPA,DR="15///1;22///1;23///"_@GMRARRAY@("GMRAERRDT")_";24////"_$G(@GMRARRAY@("GMRAERRBY"),.5) ;36 40 D ^DIE ;Entered in error on date/time by user 41 I $D(@GMRARRAY@("GMRAERRCMTS")) D ADCOM(GMRAPA,"E",$NA(@GMRARRAY@("GMRAERRCMTS"))) ;add comments 42 I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D 43 .S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U) 44 .D ^DIK ;If patient's last allergy marked as entered in error then delete assessment 45 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 46 S GMRAOUT=0 47 D EN1^GMRAEAB ;Sends entered in error bulletin to appropriate mail groups 48 D EN1^GMRAPET0(GMRADFN,GMRAPA,"E",.GMRAOUT) ;21 File Progress Note 49 S DFN=GMRADFN 50 D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA ENTERED IN ERROR")_";ORD(101," 51 D:X EN^XQOR ;Process protocols hanging off of "entered in error" protocol 52 L -^XTMP("GMRAED",GMRADFN) 53 Q 54 ; 55 ADCOM(ENTRY,TYPE,GMRACOM) ;Add comments to allergies 56 ; 57 N FDA,GMRAI,X,DIWL,DIWR 58 K ^UTILITY($J,"W") S DIWL=1,DIWR=60 S GMRAI=0 F S GMRAI=$O(@GMRACOM@(GMRAI)) Q:'+GMRAI S X=@GMRACOM@(GMRAI) D ^DIWP 59 S GMRACOM="^UTILITY($J,""W"",1)" 60 S FDA(120.826,"+1,"_ENTRY_",",.01)=$$NOW^XLFDT 61 S FDA(120.826,"+1,"_ENTRY_",",1)=DUZ 62 S FDA(120.826,"+1,"_ENTRY_",",1.5)=TYPE 63 S FDA(120.826,"+1,"_ENTRY_",",2)=GMRACOM 64 D UPDATE^DIE("","FDA") 65 Q 66 ; 67 NKA ;Change patient assessment to NKA 68 ; 69 N DA,DR,DIE,NKA,DFN 70 S DFN=ORDFN 71 L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q 72 S NKA=$$NKA^GMRANKA(DFN) 73 I NKA=0 Q ;Patient is already NKA 74 I NKA=1 S ORY="-1^Patient has active allergies - can't mark as NKA" Q 75 L +^GMR(120.86,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q 76 I '$D(^GMR(120.86,DFN,0)) D ;Add assessment entry 77 .S $P(^GMR(120.86,0),U,3,4)=(DFN_"^"_($P(^GMR(120.86,0),U,4)+1)) 78 .S ^GMR(120.86,DFN,0)=DFN_U,^GMR(120.86,"B",DFN,DFN)="" 79 L -^GMR(120.86,0) L +^GMR(120.86,DFN,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q 80 S DIE="^GMR(120.86,",DA=DFN,DR="1////0;2////"_DUZ_";3///NOW" D ^DIE 81 S ORY=0 82 L -^XTMP("GMRAED",DFN) 83 Q 84 ; 85 UPDATE(GMRAIEN,DFN,GMRARRAY) ;Add/edit allergies 86 N NEW,NKA,FDA,NODE,IEN,SUB,FILE,DA,DIK,SIEN,GMRAS0,GMRAIEN,GMRAL,GMRAPA,GMRAAR,GMRALL,GMRADFN,GMRAOUT,GMRAROT 87 S NEW='$G(GMRAIEN) 88 I NEW,$$DUPCHK^GMRAOR0(DFN,$P(@GMRARRAY@("GMRAGNT"),U))=1 S ORY="-1^Patient already has a "_$P(@GMRARRAY@("GMRAGNT"),U)_" reaction entered. No duplicates allowed." Q 89 L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q 90 D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0)) 91 S NKA='$$NKA^GMRANKA(DFN) ;is patient NKA? 92 I NKA,NEW D 93 .S FDA(120.86,"?+"_DFN_",",.01)=DFN 94 .S FDA(120.86,"?+"_DFN_",",1)=1 95 .S FDA(120.86,"?+"_DFN_",",2)=DUZ 96 .S FDA(120.86,"?+"_DFN_",",3)=$G(@GMRARRAY@("GMRAORDT"),$$NOW^XLFDT) 97 .S IEN(DFN)=DFN 98 .D UPDATE^DIE("","FDA","IEN") 99 K FDA,IEN 100 S NODE=$S($G(NEW):"+1,",1:(GMRAIEN_",")) 101 S:$G(NEW) FDA(120.8,NODE,.01)=DFN 102 I $P($G(@GMRARRAY@("GMRAGNT")),U,2)["50.67" S $P(@GMRARRAY@("GMRAGNT"),U,2)=$$TGTOG^PSNAPIS($P(@GMRARRAY@("GMRAGNT"),U))_";PSNDF(50.6," 103 F SUB="GMRAGNT;.02","GMRATYPE;3.1","GMRANATR;17","GMRAORIG;5","GMRAORDT;4","GMRAOBHX;6" D 104 .S FDA(120.8,NODE,$P(SUB,";",2))=$P(@GMRARRAY@($P(SUB,";")),U) 105 .I (SUB["GMRAGNT"),NEW S FDA(120.8,NODE,1)=$P(@GMRARRAY@($P(SUB,";")),U,2) 106 D UPDATE^DIE("","FDA","IEN") 107 S:NEW GMRAIEN=IEN(1) 108 K FDA 109 F SUB="GMRACHT","GMRAIDBN" D 110 .Q:'$D(@GMRARRAY@(SUB)) ;Stop if no updates 111 .S FILE=$S(SUB="GMRACHT":120.813,1:120.814) 112 .S FDA(FILE,"+1,"_GMRAIEN_",",.01)=@GMRARRAY@(SUB,1) 113 .S FDA(FILE,"+1,"_GMRAIEN_",",1)=DUZ 114 .D UPDATE^DIE("","FDA") 115 I $D(@GMRARRAY@("GMRACMTS")) D ADCOM(GMRAIEN,"O",$NA(@GMRARRAY@("GMRACMTS"))) ;Add comments if included 116 K FDA 117 S SUB=0 F S SUB=$O(@GMRARRAY@("GMRASYMP",SUB)) Q:'+SUB D 118 .S GMRAS0=^(SUB) ;Naked from above 119 .Q:$P(^(SUB),U)="" ;25 No text or free text entered so don't store 120 .S SIEN=$O(^GMR(120.8,GMRAIEN,10,"B",$P(GMRAS0,U),0)) 121 .I SIEN,$P(^GMR(120.8,GMRAIEN,10,SIEN,0),U,4)=$P(GMRAS0,U,3) Q ;Exists and nothing has changed 122 .I SIEN,$P(GMRAS0,U,5)="@" S DIK="^GMR(120.8,"_GMRAIEN_",",DA(1)=GMRAIEN,DA=SIEN D ^DIK Q ;Sign/symptom deleted 123 .S:'SIEN FDA(120.81,"+1,"_GMRAIEN_",",.01)=$S($P(GMRAS0,U)="FT":$O(^GMRD(120.83,"B","OTHER REACTION",0)),1:$P(GMRAS0,U)) 124 .S NODE=$S(SIEN:SIEN_","_GMRAIEN,1:"+1,"_GMRAIEN_",") 125 .S:$P(GMRAS0,U)="FT" FDA(120.81,NODE,1)=$P(GMRAS0,U,2) 126 .S FDA(120.81,NODE,2)=DUZ 127 .S FDA(120.81,NODE,3)=$P(GMRAS0,U,3) 128 .D UPDATE^DIE("","FDA","","ERR") 129 .S GMRAROT($P(GMRAS0,U,2))="" ;21 record s/s added 130 I NEW D 131 .S GMRALL(GMRAIEN)="" D VAD^GMRAUTL1(DFN,,.GMRALOC,.GMRANAM) D EN7^GMRAMCB ;Send mark chart/ID band bulletin if needed. 132 .I $P(@GMRARRAY@("GMRAOBHX"),U)="o" D ;if observed reaction add data to 120.85 133 ..S GMRAOUT=0 ;21 134 ..S GMRAL(GMRAIEN,"O",GMRAIEN)=$G(@GMRARRAY@("GMRARDT"))_"^"_$G(@GMRARRAY@("GMRASEVR")) 135 ..S GMRADFN=DFN 136 ..S GMRAL(GMRAIEN)="^^"_$P($G(@GMRARRAY@("GMRAGNT")),U)_"^^^^"_$G(@GMRARRAY@("GMRAORIG")) 137 ..M GMRAL(GMRAIEN,"S")=@GMRARRAY@("GMRASYMP") 138 ..S SUB=0 F S SUB=$O(GMRAL(GMRAIEN,"S",SUB)) Q:'+SUB S $P(GMRAL(GMRAIEN,"S",SUB),U,2)=$P(GMRAL(GMRAIEN,"S",SUB),U,2)_"^" S:$P(GMRAL(GMRAIEN,"S",SUB),U)="FT" $P(GMRAL(GMRAIEN,"S",SUB),U)=$O(^GMRD(120.83,"B","OTHER REACTION",0)) 139 ..S GMRAL=GMRAIEN 140 ..D ADVERSE^GMRAOR7(GMRAIEN,.GMRAL) ;adds entry to 120.85 141 ..S GMRAIEN(GMRAIEN)="" ;21 142 ..D EN1^GMRAPET0(GMRADFN,.GMRAIEN,"S",.GMRAOUT) ;21 File progress note 143 ..I $G(@GMRARRAY@("GMRATYPE"))["D" S GMRAPA=GMRAIEN D EN1^GMRAPTB ;21 Send med-watch update 144 .S GMRAAR=$P($G(@GMRARRAY@("GMRAGNT")),U,2),GMRAPA=GMRAIEN 145 .D EN1^GMRAOR9 S ^TMP($J,"GMRASF",1,GMRAPA)="" D RANGE^GMRASIGN(1) ;add ingredients/classes send appropriate bulletins 146 S ORY=0 147 L -^XTMP("GMRAED",DFN) 148 Q 149 ; 150 MESS ;Give out locked message 151 N GMRAXBOS,GMRAL1,GMRAL2 152 S GMRAXBOS=$$BROKER^XWBLIB ;In GUI? 153 S GMRAL1="Another user is editing this patient's allergy information." 154 S GMRAL2="Please refresh/review the patient's information before proceeding." 155 I 'GMRAXBOS W !,GMRAL1,!,GMRAL2 D WAIT^GMRAFX3 Q 156 S ORY="-1^"_GMRAL1_" "_GMRAL2 157 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPET0.m
r613 r623 1 GMRAPET0 ;HIRMFO/RM-VERIFIED ALLERGY TASKS ;11/17/06 10:272 ;;4.0;Adverse Reaction Tracking;**6,17,21,20,38**;Mar 29, 1996;Build 2 3 EN1(GMRADFN,GMRAPA,GMRACT,GMRAOUT) 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 EXIT 60 K ^TMP("TIUP",$J),GMRALOC,GMRAHLOC,GMRADUZ ;38 Removed variable GMRAPN from list of variables to kill 61 62 ASK 63 64 65 66 67 68 69 70 71 72 V 73 74 75 76 77 78 79 80 81 82 S 83 84 85 86 87 88 89 90 91 92 93 94 M 95 96 97 98 99 100 101 102 103 E 104 105 106 107 108 109 110 111 112 113 114 115 ADDCOM(TYPE,CNT) 116 117 118 119 120 121 1 GMRAPET0 ;HIRMFO/RM-VERIFIED ALLERGY TASKS ;4/7/06 12:38 2 ;;4.0;Adverse Reaction Tracking;**6,17,21,20**;Mar 29, 1996;Build 1 3 EN1(GMRADFN,GMRAPA,GMRACT,GMRAOUT) ; 4 ; ENTRY TO PERFORM ALL OF THE TASKS NECESSARY FOR 5 ; A PROGRESS NOTE TO BE ENTERED BY ART 6 ; INPUT: 7 ; GMRADFN = PATIENT IEN IN THE PATIENT FILE 8 ; GMRAPA = THE IEN IN THE PATIENT ALLERGY FILE 9 ; GMRACT = THE ACTION TO BE ENTERED FOR THIS REACTION 10 ; = "V" VERIFICATION OF A REACTION 11 ; = "S" SIGN OFF OF A REACTION 12 ; = "M" MEDWATCH FORM ENTERD 13 ; = "E" REACTION ENERED IN ERROR 14 ; OUTPUT: 15 ; GMRAOUT = REACTION ALL WAS PASSED 16 ; = 1 USER ABORT OR PN FAIL IN SOME WAY 17 ; = 0 PASSED 18 ; 19 ; VARABLE LIST 20 ; GMRACW = IS THE PROGRESS NOTE TITLE 21 ; GMRALOC = IS THE LOCATION OF THE PATIENT 22 ; GMRAHLOC = IS THE LOCATION IN FILE 44 23 ; GMRADFN = IS THE PATIENT IEN 24 ; GMRADT = IS THE DATE THE EVENT TOOK PLACE 25 ; GMRADUZ = IS THE USER WHO ENTERED THE INFORMATION 26 ; GMRAPN = IS THE IEN OF THE PROGRESS NOTE THAT WAS ENTERED 27 ; 28 ;CHECKING FOR A VALID TITLE 29 K ^TMP("TIUP",$J),GMRAPN 30 N GMRACW,GMRALOC,GMRAHLOC,GMRAXBOS ;21 31 S GMRAPN=-1,GMRAXBOS=$$BROKER^XWBLIB ;21 Got GUI? 32 I "VSME"'[GMRACT S GMRAOUT=1 D EXIT Q 33 ; The following lines of code which reference Progress Notes files and 34 ; routines will have to change when TIU replaces Progress Notes. 35 ;S GMRACW=0 F S GMRACW=$O(^GMR(121.2,"B","ADVERSE REACTION/ALLERGY",GMRACW)) Q:GMRACW<1 I $P($G(^GMR(121.1,$P($G(^GMR(121.2,GMRACW,0)),U,2),0)),U)="GENERAL NOTE" Q 36 ;-----ADDED BY VAUGHN 1/13/97 FOR TIU REPLACES LINE ABOVE---- 37 S GMRACW=+$$WHATITLE^TIUPUTU("ADVERSE REACTION/ALLERGY") 38 ;------END--- 39 ;-----CHANGED BY VAUGHN 1/13/97 FOR TIU--- 40 I GMRACW<1!($T(NEW^TIUPNAPI)']"")!('$$CANPICK^TIULP(GMRACW)) S GMRAOUT=1 D EXIT Q ;21 41 ;I GMRACW<1!($T(PN^GMRPART)']"") S GMRAOUT=1 D EXIT Q 42 ;-----END---- 43 D @GMRACT I GMRAOUT D EXIT Q ; THIS TELL'S THE PROGRAM WHERE TO GO 44 S GMRALOC="" 45 D VAD^GMRAUTL1(GMRADFN,"",.GMRALOC,"","","") 46 I GMRALOC'="" S GMRAHLOC=+$G(^DIC(42,GMRALOC,44)) 47 ;E I '$G(GMRAXBOS) D ASK ;20 48 ; Call to Progress Notes 49 ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv 50 ;S:'GMRAOUT GMRAPN=+$$PN^GMRPART(GMRADFN,GMRADUZ,GMRADT,GMRACW,GMRAHLOC) 51 ;---REPLACED LINE ABOVE WITH LINE BELOW;1/13/97 VAUGHN--- 52 I 'GMRAOUT D 53 .S GMRAPN=0 D NEW^TIUPNAPI(.GMRAPN,GMRADFN,GMRADUZ,GMRADT,GMRACW,$G(GMRAHLOC),$S($G(GMRAXBOS):0,1:1)) ;17,21 Allow editing if not in GUI 54 ;----------END------- 55 I GMRAPN=-1,'$G(GMRAXBOS) S GMRAOUT=1 W !,"No Progress Note was created." ;21 56 I GMRAPN=0,'$G(GMRAXBOS) W !,"Progress note has not been signed." ;21 57 D EXIT 58 Q 59 EXIT ; Clean up of variables 60 K ^TMP("TIUP",$J),GMRAPN,GMRALOC,GMRAHLOC,GMRADUZ 61 Q 62 ASK ; Simple file manager query for a location in file 44 63 N DIC 64 S X="" 65 S DIC=44,DIC(0)="AEQ",DIC("A")="Select a Hospital Location: ",DIC("S")="I ""CMW""[$P(^(0),U,3)" ;20 66 W !,"A progress note is being created because you "_$S(GMRACT="V":"verified",GMRACT="E":"inactivated",GMRACT="S":"activated",1:"entered a medwatch form for"),!,$P($G(^GMR(120.8,GMRAPA,0)),U,2),"." ;20 67 W !,"Enter a hospital location to be associated with this note." ;20 68 D ^DIC 69 I $D(DTOUT)!($D(DUOUT)) S GMRAOUT=1 Q 70 S GMRAHLOC=+Y 71 Q 72 V ; Verified Reaction 73 N GMRAI ;21 74 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 75 S GMRADT=$P(GMRAPA(0),U,17),GMRADUZ=$P(GMRAPA(0),U,18) 76 S:GMRADUZ="" GMRADUZ=DUZ ; Autoverified reaction being reverified 77 S ^TMP("TIUP",$J,1,0)="This patient has had an "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction reported for ",1:"allergy to ")_$P(GMRAPA(0),"^",2) 78 S ^TMP("TIUP",$J,2,0)="verified on "_$$FMTE^XLFDT(GMRADT,1)_"." 79 S GMRAI=2 D ADDCOM("V",.GMRAI) ;21 80 S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^" ;21 81 Q 82 S ; Signed Reaction 83 N GMRAI,GMRAREAC ;21 84 D NOW^%DTC 85 S GMRADT=%,GMRADUZ=DUZ 86 S GMRAREAC=0,GMRAI=3 F S GMRAREAC=$O(GMRAPA(GMRAREAC)) Q:GMRAREAC<1 S GMRAI=GMRAI+1,^TMP("TIUP",$J,GMRAI,0)=$P($G(^GMR(120.8,GMRAREAC,0)),U,2) S GMRAPA=GMRAREAC D ;21 87 .D ADDCOM("O",.GMRAI) ;21 88 .S GMRAI=GMRAI+1,^TMP("TIUP",$J,GMRAI,0)="" ;21 89 S ^TMP("TIUP",$J,1,0)="This patient has had the following reaction"_$S(GMRAI=3:" ",1:"s ") 90 S ^TMP("TIUP",$J,2,0)="signed-off on "_$$FMTE^XLFDT(GMRADT,1)_"." 91 S ^TMP("TIUP",$J,3,0)="" ;21 92 S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^" 93 Q 94 M ; MedWATCH data entered 95 N X 96 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 97 D NOW^%DTC 98 S GMRADT=%,GMRADUZ=DUZ 99 S ^TMP("TIUP",$J,1,0)="This patient has had a MEDWatch report completed on "_$$FMTE^XLFDT(GMRADT,1)_" for" 100 S ^TMP("TIUP",$J,2,0)=$S($P(GMRAPA(0),"^",14)="P":"an adverse reaction to ",1:"allergy to ")_$P(GMRAPA(0),"^",2)_"." 101 S ^TMP("TIUP",$J,0)=U_U_"2"_U_"2"_U_GMRADT_"^^^" 102 Q 103 E ; Reaction Entered in Error 104 N GMRAER,GMRAI ;21 105 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 106 S GMRAER=$G(^GMR(120.8,GMRAPA,"ER")) I GMRAER="" S GMRAOUT=1 Q 107 S GMRADT=$P(GMRAER,U,2),GMRADUZ=$P(GMRAER,U,3) 108 S ^TMP("TIUP",$J,1,0)="The "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction ",1:"allergy ")_"to "_$P(GMRAPA(0),"^",2)_" was removed on "_$$FMTE^XLFDT($P(GMRADT,"."),2)_"." ;20 109 S ^TMP("TIUP",$J,2,0)="This reaction was either an erroneous entry or was found" ;20 110 S ^TMP("TIUP",$J,3,0)="to no longer be a true "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction",1:"allergy")_"." ;20 111 S GMRAI=3 D ADDCOM("E",.GMRAI) ;21,20 112 S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^" ;21 113 Q 114 ; 115 ADDCOM(TYPE,CNT) ;Add any comments to progress note - section added in patch 21 116 N SUB,ENTRY 117 S ENTRY=$O(^GMR(120.8,GMRAPA,26,"AVER",TYPE,0)) Q:'+ENTRY 118 S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)="",CNT=CNT+1,^TMP("TIUP",$J,CNT,0)="Author's comments:" 119 S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)="" 120 S SUB=0 F S SUB=$O(^GMR(120.8,GMRAPA,26,ENTRY,2,SUB)) Q:'+SUB S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)=^GMR(120.8,GMRAPA,26,ENTRY,2,SUB,0) 121 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPFT.m
r613 r623 1 GMRAPFT ;HIRMFO/WAA- PRINT FDA REACTION BY DATE ENTERED/TRACKED ;4/10/97 09:30 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 a Tracking 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 Q 12 PRINTER ;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 22 PRINT ;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 ..Q:'$$PRDTST^GMRAUTL1(GMRADFN) ;GMRA*4*33 Exclude test patient from report if production or legacy system. 34 ..D VAD^GMRAUTL1(GMRADFN,GMRADDT,.GMRALOC,.GMRANAME,"",.GMRAPID) 35 ..I GMRALOC="" S GMRALOC="OUT PATIENT" 36 ..E S GMRALOC=$P($G(^DIC(42,GMRALOC,0)),U) 37 ..W !,$E(GMRANAME,1,30) ; Patient Name 38 ..K GMRARAC 39 ..S GMRARAC=0,GMRACNT=1 F S GMRARAC=$O(^GMR(120.85,GMRAPA1,3,GMRARAC)) Q:GMRARAC<1 D 40 ...S GMRARAC(GMRACNT)=$P($G(^GMR(120.85,GMRAPA1,3,GMRARAC,0)),U) Q:GMRARAC(GMRACNT)="" 41 ...S GMRACNT=GMRACNT+1 42 ...Q 43 ..W ?32,"Obs DT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U),"2D") ; Observed Date 44 ..W ?49,$E($G(GMRARAC(1)),1,30) ; The 1st reaction that is listed first 45 ..W !,"(",GMRAPID,")" 46 ..W ?32,"Trk DT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U,18),"2D") ; Tracking Date 47 ..W ?49,$E($G(GMRARAC(2)),1,30) ; The 2nd reaction that is listed 48 ..W !,"Loc: ",GMRALOC 49 ..W ?32,"-------------" ; Separator 50 ..W ?49,$E($G(GMRARAC(3)),1,30) ; The 3rd reaction that is listed 51 ..W !,"Obs: ",$P($G(^VA(200,$P(GMRAPA1(0),U,19),0)),U) ; User entered 52 ..D 53 ...N X1,X2,X,Y 54 ...S X2=$P(GMRAPA1(0),U),X1=$P(GMRAPA1(0),U,18) 55 ...D ^%DTC 56 ...W ?32,X," Days Difference" ;Difference 57 ...Q 58 ..W ?50,$E($G(GMRARAC(4)),1,30) ; The 4th reaction that is listed 59 ..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 60 ..W ! ; Put a blank line between the ADRs 61 ..Q 62 .Q 63 D CLOSE^GMRAUTL 64 Q 65 HEAD ; Print header information 66 I GMRAPG'=1 Q:$Y<(IOSL-4) 67 I $E(IOST,1)="C" D Q:GMRAOUT 68 .I GMRAPG=1 W @IOF Q 69 .I GMRAPG'=1 D Q:GMRAOUT 70 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 71 ..K Y 72 ..Q 73 .Q 74 Q:GMRAOUT 75 I GMRAPG'=1 W @IOF 76 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 77 W !,?22,"Adverse Reaction Tracking Report" 78 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 79 W !,"Patient",?40,"Dates",?49,"Related Reaction" 80 W !,$$REPEAT^XLFSTR("-",78) 81 S GMRAPG=GMRAPG+1 82 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 83 Q 1 GMRAPFT ;HIRMFO/WAA- PRINT FDA REACTION BY DATE ENTERED/TRACKED ;4/10/97 09:30 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 a Tracking 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 Q 12 PRINTER ;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 22 PRINT ;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 64 HEAD ; 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 -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPL.m
r613 r623 1 GMRAPL ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION ;5/2/97 14:13 2 ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5 3 EN1 ; This routine will loop through the GMRA patient allergy file 4 ; to find all patient within the date range that meet the criteria 5 ; and then display all the data for those patients first by location 6 ; then by date/time range of the reaction. 7 ; First select a starting date. 8 ; then select an end date. 9 ; then select a print device. 10 ; GMAST = START DATE 11 ; GMAEN = END DATE 12 ; 13 S GMRAOUT=0 14 D DT G:GMRAOUT EXIT 15 S GMAPG=1 16 D DEVICE 17 D EXIT 18 Q 19 GET ; This sub routine is to find all the reaction with in this observed 20 ; date range. 21 K ^TMP($J,"GMRAPL") 22 N GMADT S GMADT=GMAST-.0001 23 F S GMADT=$O(^GMR(120.8,"AODT",GMADT)) Q:GMADT<1 Q:GMADT>GMAEN D 24 .N GMRAPA S GMRAPA=0 25 .F S GMRAPA=$O(^GMR(120.8,"AODT",GMADT,GMRAPA)) Q:GMRAPA<1 D 26 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 27 ..; Stop if it is not Signed or if is E/E 28 ..Q:GMRAPA(0)="" ; Bad Zero node 29 ..Q:'$P(GMRAPA(0),U,12) ; Not signed off 30 ..Q:$P($G(^GMR(120.8,GMRAPA,"ER")),U) ; Entered in error 31 ..; Get patient name and location. 32 ..S GMRATYP=$P(GMRAPA(0),U,20) ; Get the reaction types FDO 33 ..S (GMRANAM,GMRALOC,GMRAVIP)="" 34 ..Q:'$$PRDTST^GMRAUTL1($P($G(GMRAPA(0)),U)) ;GMRA*4*33 Exclude test patient from report if production or legacy environment 35 ..D VAD^GMRAUTL1($P(GMRAPA(0),U),$P(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP) 36 ..I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U) 37 ..I GMRALOC="" S GMRALOC="Out Patients" 38 ..;Data format is as follows.... 39 ..;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction) 40 ..S ^TMP($J,"GMRAPL",$E(GMRALOC,1,30),$E(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)="" 41 ..Q 42 .Q 43 Q 44 PRINT ; Print data in the reaction global 45 I $E(IOST,1)="C" W !,"One moment please...",! 46 D GET 47 S GMRALOC="" F S GMRALOC=$O(^TMP($J,"GMRAPL",GMRALOC)) Q:GMRALOC="" D Q:GMRAOUT 48 .D HEAD Q:GMRAOUT 49 .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT 50 ..S GMRAVIP="" F S GMRAVIP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP)) Q:GMRAVIP="" D Q:GMRAOUT 51 ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT 52 ...W !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")" 53 ...S GMRATYP="" F S GMRATYP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP)) W:GMRATYP="" ! Q:GMRATYP="" D Q:GMRAOUT 54 ....S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT 55 .....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 56 .....W !,$$FMTE^XLFDT($P(GMRAPA(0),U,4),"1") ;When It was entered 57 .....W ?20,$S($P(GMRAPA(0),U,5)'="":$E($P(^VA(200,$P(GMRAPA(0),U,5),0),U),1,25),1:"<None>") ;Who Entered it 58 .....W ?46,GMRATYP ;Type of reaction 59 .....W ?50,$E($P(GMRAPA(0),U,2),1,30) ;Reaction 60 .....I $Y>(IOSL-4) D HEAD 61 .....Q 62 ....Q 63 ...Q 64 ..Q 65 .Q 66 Q 67 HEAD ; Header 68 I $E(IOST,1)="C" D Q:GMRAOUT 69 .I GMAPG=1 W @IOF Q 70 .I GMAPG'=1 D Q:GMRAOUT 71 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 72 ..K Y 73 ..Q 74 .Q 75 I GMAPG'=1 W @IOF 76 W $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG S GMAPG=GMAPG+1 77 W !,?11,"List all Signed Patient Reactions for",$S(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC 78 W !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1") 79 W !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent" 80 W !,$$REPEAT^XLFSTR("-",79) 81 Q 82 DEVICE ; Select a device to print on 83 D NOW^%DTC S GMRAPDT=X 84 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 85 I $D(IO("Q")) D Q 86 . S ZTRTN="PRINT^GMRAPL",(ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))="" 87 . S ZTDESC="List of Reactions by Ward Location within a date range." D ^%ZTLOAD 88 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 89 . Q 90 U IO D PRINT U IO(0) 91 D CLOSE^GMRAUTL 92 D EXIT 93 Q 94 DT ; Get dates 95 S GMAST=$$DATE("Enter Start Date: ") I GMAST<1 S GMRAOUT=1 Q 96 S GMAEN=$$DATE("Enter Ending Date: ",GMAST) I GMAEN<1 S GMRAOUT=1 Q 97 S GMAEN=GMAEN_".24" ;Gives results through entire day when 'T' is selected 98 Q 99 DATE(PROMPT,GMADATE) ; Date sub routine 100 S GMADATE=$G(GMADATE) 101 S DATE="" 102 N DIR 103 S DIR(0)="DAO^"_GMADATE_"::AEP",DIR("A")=PROMPT 104 D ^DIR I $D(DIRUT) S DATE="" Q DATE 105 S DATE=Y 106 Q DATE 107 EXIT ;EXIT ROUTINE DATA 108 K ^TMP($J,"GMRAPL") 109 D KILL^XUSCLEAN 110 Q 1 GMRAPL ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION ;5/2/97 14:13 2 ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996 3 EN1 ; This routine will loop thourgh the GMRA patient allergy file 4 ; to find all patient within the date range that meet the critera 5 ; and then display all the data for those patients first by location 6 ; then by date/time range of the reaction. 7 ; First select a starting date. 8 ; then select an end date. 9 ; then select a print device. 10 ; GMAST = START DATE 11 ; GMAEN = END DATE 12 ; 13 S GMRAOUT=0 14 D DT G:GMRAOUT EXIT 15 S GMAPG=1 16 D DEVICE 17 D EXIT 18 Q 19 GET ; This sub routine is to find all the reaction with in this observed 20 ; date range. 21 K ^TMP($J,"GMRAPL") 22 N GMADT S GMADT=GMAST-.0001 23 F S GMADT=$O(^GMR(120.8,"AODT",GMADT)) Q:GMADT<1 Q:GMADT>GMAEN D 24 .N GMRAPA S GMRAPA=0 25 .F S GMRAPA=$O(^GMR(120.8,"AODT",GMADT,GMRAPA)) Q:GMRAPA<1 D 26 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 27 ..; Stop if it is not Signed or if is E/E 28 ..Q:GMRAPA(0)="" ; Bad Zero node 29 ..Q:'$P(GMRAPA(0),U,12) ; Not signed off 30 ..Q:$P($G(^GMR(120.8,GMRAPA,"ER")),U) ; Entered in error 31 ..; Get patient name and location. 32 ..S GMRATYP=$P(GMRAPA(0),U,20) ; Get the reaction types FDO 33 ..S (GMRANAM,GMRALOC,GMRAVIP)="" 34 ..D VAD^GMRAUTL1($P(GMRAPA(0),U),$P(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP) 35 ..I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U) 36 ..I GMRALOC="" S GMRALOC="Out Patients" 37 ..;Data format is as follows.... 38 ..;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction) 39 ..S ^TMP($J,"GMRAPL",$E(GMRALOC,1,30),$E(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)="" 40 ..Q 41 .Q 42 Q 43 PRINT ; Print data in the reaction global 44 I $E(IOST,1)="C" W !,"One moment please...",! 45 D GET 46 S GMRALOC="" F S GMRALOC=$O(^TMP($J,"GMRAPL",GMRALOC)) Q:GMRALOC="" D Q:GMRAOUT 47 .D HEAD Q:GMRAOUT 48 .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT 49 ..S GMRAVIP="" F S GMRAVIP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP)) Q:GMRAVIP="" D Q:GMRAOUT 50 ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT 51 ...W !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")" 52 ...S GMRATYP="" F S GMRATYP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP)) W:GMRATYP="" ! Q:GMRATYP="" D Q:GMRAOUT 53 ....S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT 54 .....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 55 .....W !,$$FMTE^XLFDT($P(GMRAPA(0),U,4),"1") ;When It was entered 56 .....W ?20,$S($P(GMRAPA(0),U,5)'="":$E($P(^VA(200,$P(GMRAPA(0),U,5),0),U),1,25),1:"<None>") ;Who Entered it 57 .....W ?46,GMRATYP ;Type of reaction 58 .....W ?50,$E($P(GMRAPA(0),U,2),1,30) ;Reaction 59 .....I $Y>(IOSL-4) D HEAD 60 .....Q 61 ....Q 62 ...Q 63 ..Q 64 .Q 65 Q 66 HEAD ; Header 67 I $E(IOST,1)="C" D Q:GMRAOUT 68 .I GMAPG=1 W @IOF Q 69 .I GMAPG'=1 D Q:GMRAOUT 70 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 71 ..K Y 72 ..Q 73 .Q 74 I GMAPG'=1 W @IOF 75 W $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG S GMAPG=GMAPG+1 76 W !,?11,"List all Signed Patient Reactions for",$S(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC 77 W !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1") 78 W !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent" 79 W !,$$REPEAT^XLFSTR("-",79) 80 Q 81 DEVICE ; Select a device to print on 82 D NOW^%DTC S GMRAPDT=X 83 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 84 I $D(IO("Q")) D Q 85 . S ZTRTN="PRINT^GMRAPL",(ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))="" 86 . S ZTDESC="List of Reactions by Ward Location within a date range." D ^%ZTLOAD 87 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 88 . Q 89 U IO D PRINT U IO(0) 90 D CLOSE^GMRAUTL 91 D EXIT 92 Q 93 DT ; Get dates 94 S GMAST=$$DATE("Enter Start Date: ") I GMAST<1 S GMRAOUT=1 Q 95 S GMAEN=$$DATE("Enter Ending Date: ",GMAST) I GMAEN<1 S GMRAOUT=1 Q 96 S GMAEN=GMAEN_".24" ;Gives results through entire day when 'T' is selected 97 Q 98 DATE(PROMPT,GMADATE) ; Date sub routine 99 S GMADATE=$G(GMADATE) 100 S DATE="" 101 N DIR 102 S DIR(0)="DAO^"_GMADATE_"::AEP",DIR("A")=PROMPT 103 D ^DIR I $D(DIRUT) S DATE="" Q DATE 104 S DATE=Y 105 Q DATE 106 EXIT ;EXIT ROUTINE DATA 107 K ^TMP($J,"GMRAPL") 108 D KILL^XUSCLEAN 109 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPNA.m
r613 r623 1 GMRAPNA ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;12/1/95 14:15 2 ;;4.0;Adverse Reaction Tracking;**30,33**;Mar 29, 1996;Build 5 3 EN1 ; Entry for LIST BY LOCATION OF UNDOCUMENTED ALLERGIES option 4 D EN1^GMRACMR G:GMRAOUT EXIT 5 D DEV 6 D EXIT 7 Q 8 DEV ; *** Select output device, force queuing 9 ;***** NOTE: CHECKS TO SEE IF VALID DEVICE IS SELECTED THEN ALL I HAVE TO DO IS RUN TASK MAN. 10 S GMRAZIS="" S:GMRASEL'="1," GMRAZIS="Q" 11 W !! D DEV^GMRAUTL I POP G EXIT 12 I $D(IO("Q")) D G EXIT 13 . K IO("Q") 14 . S ZTRTN="ENTSK^GMRAPNA" 15 . S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")="" 16 . S ZTDESC="List of patients who have not been asked of allergies" 17 . D ^%ZTLOAD 18 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...") 19 . Q 20 E D ENTSK 21 Q 22 ENTSK U IO 23 D EN1^GMRACMR2,EN1^GMRACMR3 24 S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y) 25 D PRINT 26 G EXIT 27 PRINT ;PRINT THE DATE 28 D PRE 29 S GMRAHLOC="" F S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC=""!(GMRAOUT) S GMRAX=0 F S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1 D Q:GMRAOUT 30 .S GMRA=$G(^TMP($J,"GMRAWC",GMRAX)),GMRACNT=0 31 .I GMRA="" Q 32 .D HEAD Q:GMRAOUT 33 .W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U) 34 .S GMRADATE=0 F S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE)) Q:GMRADATE="" S GMRADFN=0 Q:GMRAOUT F S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1 D Q:GMRAOUT 35 ..I '$D(^GMR(120.86,GMRADFN,0)) 36 ..E I +$P(^GMR(120.86,GMRADFN,0),U,4)<$G(GMRAED,9999999) Q 37 ..Q:'$D(^DPT(GMRADFN,0)) 38 ..Q:$$DECEASED^GMRAFX(GMRADFN) ;GMRA*4*30 Prevent deceased patients from appearing on this report. 39 ..Q:'$$PRDTST^GMRAUTL1(GMRADFN) ;GMRA*4*33 Exclude test patient from report if production or legacy environment. 40 ..S GMRACNT=GMRACNT+1 41 ..W !,$P(^DPT(GMRADFN,0),U) S DFN=GMRADFN,VAINDT=$S(GMRADATE="CURRENT":DT,1:GMRADATE) D 1^VADPT W ?30,VA("PID") W:GMRA'="C" ?45,$P(VAIN(2),U,2) 42 ..I VAIN(5)'="" W !,?5,"Room/Bed: ",VAIN(5) 43 ..D KVAR^VADPT K VA,DFN 44 ..I $Y>(IOSL-4) D HEAD Q:GMRAOUT 45 ..Q 46 .D NOPAT 47 .Q 48 D CLOSE^GMRAUTL 49 Q 50 NOPAT ; If there are no patients print informational message 51 Q:GMRACNT 52 W !,?24,"* No Patients for this ",$S(GMRA="W":"Ward",GMRA="M":"Module",GMRA="C":"Clinic",1:"UNKNOWN")," *" 53 W ! 54 Q 55 HEAD ;HEADER PAGE FOR PRINTOUT 56 S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF 57 I $E(IOST,1)="C",GMRAPAGE'=1 D Q:GMRAOUT 58 .S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 59 .K Y 60 .Q 61 I GMRAPAGE'=1 W @IOF 62 W !,GMRAPDT,?23,"PATIENTS NOT ASKED ABOUT ALLERGIES",?70,"PAGE ",GMRAPAGE 63 I GMRASEL["1" S GMRATL="CURRENT INPATIENTS" 64 I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS") 65 I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS") 66 W !,?(40-($L(GMRATL)/2)),GMRATL 67 I (GMRASEL["2"!(GMRASEL["3")) W !,?23,"FROM ",$$DATE^GMRAUTL1(GMRAST),?42,"TO ",$$DATE^GMRAUTL1(GMRAED) 68 W !!,"PATIENT",?30,"SSN" W:GMRA'="C" ?45,"PROVIDER" 69 W !,$$REPEAT^XLFSTR("-",78) 70 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 71 Q 72 PRE ; This will validate the TMP global and fire off Xref 73 N GMRAX,GMRAY,GMRAT1,GMRAT2,GMRAT3 74 Q:'$D(^TMP($J,"GMRAWC")) 75 S GMRAX=0 F S GMRAX=$O(^TMP($J,"GMRAWC",GMRAX)) Q:GMRAX<1 D 76 .S GMRAY=^TMP($J,"GMRAWC",GMRAX) 77 .S GMRAT1=$P($G(^SC(GMRAX,0)),U,2) 78 .S GMRAT2=$P($G(^SC(GMRAX,0)),U) 79 .S GMRAT3=$S(GMRAT1'="":GMRAT1,1:GMRAT2) 80 .S ^TMP($J,"GMRAWC","C",GMRAT3,GMRAX)="" 81 .Q 82 Q 83 EXIT ; 84 K ^TMP($J,"GMRAWC") 85 D KILL^XUSCLEAN 86 Q 1 GMRAPNA ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;12/1/95 14:15 2 ;;4.0;Adverse Reaction Tracking;**30**;Mar 29, 1996 3 EN1 ; Entry for LIST BY LOCATION OF UNDOCUMENTED ALLERGIES option 4 D EN1^GMRACMR G:GMRAOUT EXIT 5 D DEV 6 D EXIT 7 Q 8 DEV ; *** Select output device, force queueing 9 ;***** NOTE: CHECKS TO SEE IF VALID DEVICE IS SELECTED THEN ALL I HAVE TO DO IS RUN TASK MAN. 10 S GMRAZIS="" S:GMRASEL'="1," GMRAZIS="Q" 11 W !! D DEV^GMRAUTL I POP G EXIT 12 I $D(IO("Q")) D G EXIT 13 . K IO("Q") 14 . S ZTRTN="ENTSK^GMRAPNA" 15 . S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")="" 16 . S ZTDESC="List of patients who have not been asked of allergies" 17 . D ^%ZTLOAD 18 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...") 19 . Q 20 E D ENTSK 21 Q 22 ENTSK U IO 23 D EN1^GMRACMR2,EN1^GMRACMR3 24 S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y) 25 D PRINT 26 G EXIT 27 PRINT ;PRINT THE DATE 28 D PRE 29 S GMRAHLOC="" F S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC=""!(GMRAOUT) S GMRAX=0 F S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1 D Q:GMRAOUT 30 .S GMRA=$G(^TMP($J,"GMRAWC",GMRAX)),GMRACNT=0 31 .I GMRA="" Q 32 .D HEAD Q:GMRAOUT 33 .W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U) 34 .S GMRADATE=0 F S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE)) Q:GMRADATE="" S GMRADFN=0 Q:GMRAOUT F S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1 D Q:GMRAOUT 35 ..I '$D(^GMR(120.86,GMRADFN,0)) 36 ..E I +$P(^GMR(120.86,GMRADFN,0),U,4)<$G(GMRAED,9999999) Q 37 ..Q:'$D(^DPT(GMRADFN,0)) 38 ..Q:$$DECEASED^GMRAFX(GMRADFN) ;GMRA*4*30 Prevent deceased patients from appearing on this report. 39 ..S GMRACNT=GMRACNT+1 40 ..W !,$P(^DPT(GMRADFN,0),U) S DFN=GMRADFN,VAINDT=$S(GMRADATE="CURRENT":DT,1:GMRADATE) D 1^VADPT W ?30,VA("PID") W:GMRA'="C" ?45,$P(VAIN(2),U,2) 41 ..I VAIN(5)'="" W !,?5,"Room/Bed: ",VAIN(5) 42 ..D KVAR^VADPT K VA,DFN 43 ..I $Y>(IOSL-4) D HEAD Q:GMRAOUT 44 ..Q 45 .D NOPAT 46 .Q 47 D CLOSE^GMRAUTL 48 Q 49 NOPAT ; If there are no patients print informational message 50 Q:GMRACNT 51 W !,?24,"* No Patients for this ",$S(GMRA="W":"Ward",GMRA="M":"Module",GMRA="C":"Clinic",1:"UNKNOWN")," *" 52 W ! 53 Q 54 HEAD ;HEADER PAGE FOR PRINTOUT 55 S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF 56 I $E(IOST,1)="C",GMRAPAGE'=1 D Q:GMRAOUT 57 .S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 58 .K Y 59 .Q 60 I GMRAPAGE'=1 W @IOF 61 W !,GMRAPDT,?23,"PATIENTS NOT ASKED ABOUT ALLERGIES",?70,"PAGE ",GMRAPAGE 62 I GMRASEL["1" S GMRATL="CURRENT INPATIENTS" 63 I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS") 64 I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS") 65 W !,?(40-($L(GMRATL)/2)),GMRATL 66 I (GMRASEL["2"!(GMRASEL["3")) W !,?23,"FROM ",$$DATE^GMRAUTL1(GMRAST),?42,"TO ",$$DATE^GMRAUTL1(GMRAED) 67 W !!,"PATIENT",?30,"SSN" W:GMRA'="C" ?45,"PROVIDER" 68 W !,$$REPEAT^XLFSTR("-",78) 69 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 70 Q 71 PRE ; This will validate the TMP global and fire off Xref 72 N GMRAX,GMRAY,GMRAT1,GMRAT2,GMRAT3 73 Q:'$D(^TMP($J,"GMRAWC")) 74 S GMRAX=0 F S GMRAX=$O(^TMP($J,"GMRAWC",GMRAX)) Q:GMRAX<1 D 75 .S GMRAY=^TMP($J,"GMRAWC",GMRAX) 76 .S GMRAT1=$P($G(^SC(GMRAX,0)),U,2) 77 .S GMRAT2=$P($G(^SC(GMRAX,0)),U) 78 .S GMRAT3=$S(GMRAT1'="":GMRAT1,1:GMRAT2) 79 .S ^TMP($J,"GMRAWC","C",GMRAT3,GMRAX)="" 80 .Q 81 Q 82 EXIT ; 83 K ^TMP($J,"GMRAWC") 84 D KILL^XUSCLEAN 85 Q -
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 -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST2.m
r613 r623 1 GMRAPST2 ;HIRMFO/WAA- PRINT SUM LISTING OF OUT COMES ;3/5/97 14:50 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 Q 12 PRINTER ;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^GMRAPST2",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 16 . S ZTDESC="Summary of Outcomes" 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 Q 21 PRINT ;Queue point for report 22 ;loop through the 120.85 file and look for the field that 23 D NOW^%DTC S GMRADPDT=X 24 S GMRADATE=GMAST-.0001,GMRAPG=1 25 S (GMRARRAY("YES"),GMRARRAY("NO"),GMRARRAY("NULL"))="",GMRATOT=0 26 F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D 27 .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D 28 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node 29 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;Entered in Error data 30 ..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2)) ;GMRA*4*33 Exclude test patient from report if production or legacy environment. 31 ..S GMRATOT=GMRATOT+1 32 ..F GMRALAB=1:1 S GMRALINE=$T(TEXT+GMRALAB) Q:$P(GMRALINE,";",3)="" D 33 ...S GMRAP=$P(GMRALINE,";",4) 34 ...I $P(GMRAPA1(0),U,GMRAP)="y" S $P(GMRARRAY("YES"),U,GMRAP)=$P(GMRARRAY("YES"),U,GMRAP)+1 35 ...I $P(GMRAPA1(0),U,GMRAP)="n" S $P(GMRARRAY("NO"),U,GMRAP)=$P(GMRARRAY("NO"),U,GMRAP)+1 36 ...I $P(GMRAPA1(0),U,GMRAP)="" S $P(GMRARRAY("NULL"),U,GMRAP)=$P(GMRARRAY("NULL"),U,GMRAP)+1 37 ...Q 38 ..Q 39 .Q 40 Q:GMRAOUT 41 D HEAD 42 S (GMRAY,GMRAN,GMRANU)=0 43 F GMRALAB=1:1 S GMRALINE=$T(TEXT+GMRALAB) Q:$P(GMRALINE,";",3)="" D 44 .N GMRAP,GMRATAB 45 .S GMRAP=$P(GMRALINE,";",4) 46 .S GMRATAB=40-$L($P(GMRALINE,";",3)) 47 .W !,?GMRATAB,$P(GMRALINE,";",3) 48 .W ?42,$P(GMRARRAY("YES"),U,GMRAP) 49 .S GMRAY=GMRAY+$P(GMRARRAY("YES"),U,GMRAP) 50 .W ?53,"| ",$P(GMRARRAY("NO"),U,GMRAP) 51 .S GMRAN=GMRAN+$P(GMRARRAY("NO"),U,GMRAP) 52 .W ?63,"| ",$P(GMRARRAY("NULL"),U,GMRAP) 53 .S GMRANU=GMRANU+$P(GMRARRAY("NULL"),U,GMRAP) 54 .Q 55 W !,?30," ---------------------------------------" 56 W !,?32,"Totals: ",?42,GMRAY,?53,"| ",GMRAN,?63,"| ",GMRANU 57 W !!,?22,"Total number of records processed ",GMRATOT 58 D CLOSE^GMRAUTL 59 Q 60 ;has the patient died within the date 61 HEAD ; Print header information 62 I GMRAPG'=1 Q:$Y<(IOSL-4) 63 I $E(IOST,1)="C" D Q:GMRAOUT 64 .I GMRAPG=1 W @IOF Q 65 .I GMRAPG'=1 D Q:GMRAOUT 66 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 67 ..K Y 68 ..Q 69 .Q 70 Q:GMRAOUT 71 I GMRAPG'=1 W @IOF 72 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 73 W !,?30,"Summary of Outcomes" 74 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 75 W !,?42,"Yes",?55,"No",?65,"No Response" 76 W !,$$REPEAT^XLFSTR("-",79) 77 S GMRAPG=GMRAPG+1 78 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 79 Q 80 TEXT ;;these are the labels that will denote the field data 81 ;;Patients that Died: ;3 82 ;;Reactions treated with RX drugs: ;4 83 ;;Life Threatening illness: ;5 84 ;;Required ER/MD visit: ;6 85 ;;Required hospitalization: ;7 86 ;;Prolonged Hospitalization: ;9 87 ;;Resulted in permanent disability: ;10 88 ;;Patient recovered: ;11 89 ;;Congenital Anomaly: ;16 90 ;;Required intervention: ;17 91 ;; 1 GMRAPST2 ;HIRMFO/WAA- PRINT SUM LISTING OF OUT COMES ;3/5/97 14:50 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 Q 12 PRINTER ;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^GMRAPST2",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 16 . S ZTDESC="Summary of Outcomes" 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 Q 21 PRINT ;Queue point for report 22 ;loop through the 120.85 file and look for the field that 23 D NOW^%DTC S GMRADPDT=X 24 S GMRADATE=GMAST-.0001,GMRAPG=1 25 S (GMRARRAY("YES"),GMRARRAY("NO"),GMRARRAY("NULL"))="",GMRATOT=0 26 F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D 27 .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D 28 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node 29 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;Entered in Error data 30 ..S GMRATOT=GMRATOT+1 31 ..F GMRALAB=1:1 S GMRALINE=$T(TEXT+GMRALAB) Q:$P(GMRALINE,";",3)="" D 32 ...S GMRAP=$P(GMRALINE,";",4) 33 ...I $P(GMRAPA1(0),U,GMRAP)="y" S $P(GMRARRAY("YES"),U,GMRAP)=$P(GMRARRAY("YES"),U,GMRAP)+1 34 ...I $P(GMRAPA1(0),U,GMRAP)="n" S $P(GMRARRAY("NO"),U,GMRAP)=$P(GMRARRAY("NO"),U,GMRAP)+1 35 ...I $P(GMRAPA1(0),U,GMRAP)="" S $P(GMRARRAY("NULL"),U,GMRAP)=$P(GMRARRAY("NULL"),U,GMRAP)+1 36 ...Q 37 ..Q 38 .Q 39 Q:GMRAOUT 40 D HEAD 41 S (GMRAY,GMRAN,GMRANU)=0 42 F GMRALAB=1:1 S GMRALINE=$T(TEXT+GMRALAB) Q:$P(GMRALINE,";",3)="" D 43 .N GMRAP,GMRATAB 44 .S GMRAP=$P(GMRALINE,";",4) 45 .S GMRATAB=40-$L($P(GMRALINE,";",3)) 46 .W !,?GMRATAB,$P(GMRALINE,";",3) 47 .W ?42,$P(GMRARRAY("YES"),U,GMRAP) 48 .S GMRAY=GMRAY+$P(GMRARRAY("YES"),U,GMRAP) 49 .W ?53,"| ",$P(GMRARRAY("NO"),U,GMRAP) 50 .S GMRAN=GMRAN+$P(GMRARRAY("NO"),U,GMRAP) 51 .W ?63,"| ",$P(GMRARRAY("NULL"),U,GMRAP) 52 .S GMRANU=GMRANU+$P(GMRARRAY("NULL"),U,GMRAP) 53 .Q 54 W !,?30," ---------------------------------------" 55 W !,?32,"Totals: ",?42,GMRAY,?53,"| ",GMRAN,?63,"| ",GMRANU 56 W !!,?22,"Total number of records processed ",GMRATOT 57 D CLOSE^GMRAUTL 58 Q 59 ;has the patient died with inthe dat 60 HEAD ; Print header information 61 I GMRAPG'=1 Q:$Y<(IOSL-4) 62 I $E(IOST,1)="C" D Q:GMRAOUT 63 .I GMRAPG=1 W @IOF Q 64 .I GMRAPG'=1 D Q:GMRAOUT 65 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 66 ..K Y 67 ..Q 68 .Q 69 Q:GMRAOUT 70 I GMRAPG'=1 W @IOF 71 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 72 W !,?30,"Summary of Outcomes" 73 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 74 W !,?42,"Yes",?55,"No",?65,"No Response" 75 W !,$$REPEAT^XLFSTR("-",79) 76 S GMRAPG=GMRAPG+1 77 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 78 Q 79 TEXT ;;these are the labeles that will denote the field data 80 ;;Patients that Died: ;3 81 ;;Reactions treated with RX drugs: ;4 82 ;;Life Threatening illness: ;5 83 ;;Required ER/MD visit: ;6 84 ;;Required hospitalization: ;7 85 ;;Prolonged Hospitalization: ;9 86 ;;Resulted in permanent disability: ;10 87 ;;Patient recovered: ;11 88 ;;Congenital Anomaly: ;16 89 ;;Required intervention: ;17 90 ;; -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST3.m
r613 r623 1 GMRAPST3 ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY REACT ;3/5/97 15:14 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,"GMRAPST3B") 12 K ^TMP($J,"GMRAPST3A") 13 Q 14 PRINTER ;Select printer 15 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 16 I $D(IO("Q")) D Q 17 . S ZTRTN="PRINT^GMRAPST3",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 18 . S ZTDESC="Frequency Distribution of Causative Agents" 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 D NOW^%DTC S GMRADPDT=X 26 S GMRADATE=GMAST-.0001,GMRAPG=1 27 K ^TMP($J,"GMRAPST3A") 28 S GMRATOT=0 29 F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D 30 .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D 31 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node 32 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;Entered in error data 33 ..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2)) ;GMRA*4*33 Exclude test patient from report if production or legacy environment. 34 ..S GMRATOT=GMRATOT+1 35 ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA 36 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 37 ..S GMRAREC=$P(GMRAPA(0),U,2) 38 ..S ^TMP($J,"GMRAPST3A",GMRAREC)=$G(^TMP($J,"GMRAPST3A",GMRAREC))+1 39 ..Q 40 .Q 41 Q:GMRAOUT 42 Q:'$D(^TMP($J,"GMRAPST3A")) 43 K ^TMP($J,"GMRAPST3B") 44 S GMRAREC="" 45 F S GMRAREC=$O(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRAREC="" D 46 .S GMRARECN=$G(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRARECN="" 47 .S ^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)="" 48 .Q 49 D HEAD 50 S GMRARECN="" 51 F S GMRARECN=$O(^TMP($J,"GMRAPST3B",GMRARECN),-1) Q:GMRARECN<1 D Q:GMRAOUT 52 .S GMRAREC="" 53 .F S GMRAREC=$O(^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)) Q:GMRAREC="" D Q:GMRAOUT 54 ..S GMRATAB=30-$L($E(GMRAREC,1,30)) 55 ..W !,?GMRATAB,$E(GMRAREC,1,30)," :",$J(GMRARECN,5) 56 ..D HEAD Q:GMRAOUT 57 ..Q 58 .Q 59 W !!,?22,"Total number of records processed ",GMRATOT 60 D CLOSE^GMRAUTL 61 Q 62 ;has the patient died within the date 63 HEAD ; Print header information 64 I GMRAPG'=1 Q:$Y<(IOSL-4) 65 I $E(IOST,1)="C" D Q:GMRAOUT 66 .I GMRAPG=1 W @IOF Q 67 .I GMRAPG'=1 D Q:GMRAOUT 68 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 69 ..K Y 70 ..Q 71 .Q 72 Q:GMRAOUT 73 I GMRAPG'=1 W @IOF 74 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 75 W !,?20,"Frequency Distribution of Causative Agents" 76 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 77 W !,"Causative Agents",?34,"Number" 78 W !,$$REPEAT^XLFSTR("-",79) 79 S GMRAPG=GMRAPG+1 80 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 81 Q 1 GMRAPST3 ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY REACT ;3/5/97 15:14 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,"GMRAPST3B") 12 K ^TMP($J,"GMRAPST3A") 13 Q 14 PRINTER ;Select printer 15 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 16 I $D(IO("Q")) D Q 17 . S ZTRTN="PRINT^GMRAPST3",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 18 . S ZTDESC="Frequency Distribution of Causative Agents" 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 D NOW^%DTC S GMRADPDT=X 26 S GMRADATE=GMAST-.0001,GMRAPG=1 27 K ^TMP($J,"GMRAPST3A") 28 S GMRATOT=0 29 F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D 30 .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D 31 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node 32 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;Entered in error data 33 ..S GMRATOT=GMRATOT+1 34 ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA 35 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 36 ..S GMRAREC=$P(GMRAPA(0),U,2) 37 ..S ^TMP($J,"GMRAPST3A",GMRAREC)=$G(^TMP($J,"GMRAPST3A",GMRAREC))+1 38 ..Q 39 .Q 40 Q:GMRAOUT 41 Q:'$D(^TMP($J,"GMRAPST3A")) 42 K ^TMP($J,"GMRAPST3B") 43 S GMRAREC="" 44 F S GMRAREC=$O(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRAREC="" D 45 .S GMRARECN=$G(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRARECN="" 46 .S ^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)="" 47 .Q 48 D HEAD 49 S GMRARECN="" 50 F S GMRARECN=$O(^TMP($J,"GMRAPST3B",GMRARECN),-1) Q:GMRARECN<1 D Q:GMRAOUT 51 .S GMRAREC="" 52 .F S GMRAREC=$O(^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)) Q:GMRAREC="" D Q:GMRAOUT 53 ..S GMRATAB=30-$L($E(GMRAREC,1,30)) 54 ..W !,?GMRATAB,$E(GMRAREC,1,30)," :",$J(GMRARECN,5) 55 ..D HEAD Q:GMRAOUT 56 ..Q 57 .Q 58 W !!,?22,"Total number of records processed ",GMRATOT 59 D CLOSE^GMRAUTL 60 Q 61 ;has the patient died with inthe dat 62 HEAD ; Print header information 63 I GMRAPG'=1 Q:$Y<(IOSL-4) 64 I $E(IOST,1)="C" D Q:GMRAOUT 65 .I GMRAPG=1 W @IOF Q 66 .I GMRAPG'=1 D Q:GMRAOUT 67 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 68 ..K Y 69 ..Q 70 .Q 71 Q:GMRAOUT 72 I GMRAPG'=1 W @IOF 73 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 74 W !,?20,"Frequency Distribution of Causative Agents" 75 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 76 W !,"Causative Agents",?34,"Number" 77 W !,$$REPEAT^XLFSTR("-",79) 78 S GMRAPG=GMRAPG+1 79 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 80 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST4.m
r613 r623 1 GMRAPST4 ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY DC ;3/5/97 15:15 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 K ^TMP($J,"GMRAPST4") 11 D KILL^XUSCLEAN 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^GMRAPST4",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 17 . S ZTDESC="Frequency Distribution of Drug Classes" 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 D NOW^%DTC S GMRADPDT=X 25 S GMRADATE=GMAST-.0001,GMRAPG=1 26 K ^TMP($J,"GMRAPST4") 27 S GMRATOT=0 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 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;Entered in error data 32 ..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2)) ;GMRA*4*33 Exclude test patient from report if production or legacy environment. 33 ..S GMRATOT=GMRATOT+1 34 ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA 35 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 36 ..S GMRADC=0 37 ..F S GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) Q:GMRADC<1 D 38 ...S GMRADCN=$P($G(^GMR(120.8,GMRAPA,3,GMRADC,0)),U) Q:GMRADCN="" 39 ...S ^TMP($J,"GMRAPST4",GMRADCN)=$G(^TMP($J,"GMRAPST4",GMRADCN))+1 40 ...Q 41 ..Q 42 .Q 43 Q:GMRAOUT 44 Q:'$D(^TMP($J,"GMRAPST4")) 45 S GMRADCN=0 46 ;Sort in value order. 47 F S GMRADCN=$O(^TMP($J,"GMRAPST4",GMRADCN)) Q:GMRADCN<1 D 48 .S GMRADC=$G(^TMP($J,"GMRAPST4",GMRADCN)) Q:GMRADC<1 49 .S ^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)="" 50 .Q 51 D HEAD 52 S GMRADC="" 53 F S GMRADC=$O(^TMP($J,"GMRAPST4","B",GMRADC),-1) Q:GMRADC<1 D Q:GMRAOUT 54 .S GMRADCN=0 55 .F S GMRADCN=$O(^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)) Q:GMRADCN<1 D Q:GMRAOUT 56 ..S GMRADC0=$G(^PS(50.605,GMRADCN,0)) Q:GMRADC0="" 57 ..S GMRATAB=30-$L($E($P(GMRADC0,U,2),1,30)) 58 ..W !,?GMRATAB,$E($P(GMRADC0,U,2),1,30)," (",$P(GMRADC0,U),") :",$J(GMRADC,5) 59 ..D HEAD Q:GMRAOUT 60 ..Q 61 .Q 62 W !!,?22,"Total number of records processed ",GMRATOT 63 D CLOSE^GMRAUTL 64 Q 65 HEAD ; Print header information 66 I GMRAPG'=1 Q:$Y<(IOSL-4) 67 I $E(IOST,1)="C" D Q:GMRAOUT 68 .I GMRAPG=1 W @IOF Q 69 .I GMRAPG'=1 D Q:GMRAOUT 70 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 71 ..K Y 72 ..Q 73 .Q 74 Q:GMRAOUT 75 I GMRAPG'=1 W @IOF 76 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 77 W !,?20,"Frequency Distribution of Drug Classes" 78 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 79 W !,"Drug Class",?39,"Number" 80 W !,$$REPEAT^XLFSTR("-",79) 81 S GMRAPG=GMRAPG+1 82 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 83 Q 1 GMRAPST4 ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY DC ;3/5/97 15:15 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 K ^TMP($J,"GMRAPST4") 11 D KILL^XUSCLEAN 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^GMRAPST4",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 17 . S ZTDESC="Frequency Distribution of Drug Classes" 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 D NOW^%DTC S GMRADPDT=X 25 S GMRADATE=GMAST-.0001,GMRAPG=1 26 K ^TMP($J,"GMRAPST4") 27 S GMRATOT=0 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 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;Entered in error data 32 ..S GMRATOT=GMRATOT+1 33 ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA 34 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 35 ..S GMRADC=0 36 ..F S GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) Q:GMRADC<1 D 37 ...S GMRADCN=$P($G(^GMR(120.8,GMRAPA,3,GMRADC,0)),U) Q:GMRADCN="" 38 ...S ^TMP($J,"GMRAPST4",GMRADCN)=$G(^TMP($J,"GMRAPST4",GMRADCN))+1 39 ...Q 40 ..Q 41 .Q 42 Q:GMRAOUT 43 Q:'$D(^TMP($J,"GMRAPST4")) 44 S GMRADCN=0 45 ;Sort in value order. 46 F S GMRADCN=$O(^TMP($J,"GMRAPST4",GMRADCN)) Q:GMRADCN<1 D 47 .S GMRADC=$G(^TMP($J,"GMRAPST4",GMRADCN)) Q:GMRADC<1 48 .S ^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)="" 49 .Q 50 D HEAD 51 S GMRADC="" 52 F S GMRADC=$O(^TMP($J,"GMRAPST4","B",GMRADC),-1) Q:GMRADC<1 D Q:GMRAOUT 53 .S GMRADCN=0 54 .F S GMRADCN=$O(^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)) Q:GMRADCN<1 D Q:GMRAOUT 55 ..S GMRADC0=$G(^PS(50.605,GMRADCN,0)) Q:GMRADC0="" 56 ..S GMRATAB=30-$L($E($P(GMRADC0,U,2),1,30)) 57 ..W !,?GMRATAB,$E($P(GMRADC0,U,2),1,30)," (",$P(GMRADC0,U),") :",$J(GMRADC,5) 58 ..D HEAD Q:GMRAOUT 59 ..Q 60 .Q 61 W !!,?22,"Total number of records processed ",GMRATOT 62 D CLOSE^GMRAUTL 63 Q 64 HEAD ; 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 !,?20,"Frequency Distribution of Drug Classes" 77 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 78 W !,"Drug Class",?39,"Number" 79 W !,$$REPEAT^XLFSTR("-",79) 80 S GMRAPG=GMRAPG+1 81 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 82 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST5.m
r613 r623 1 GMRAPST5 ;HIRMFO/WAA- PRINT TOTAL NUMBER OF REPORTED REACTION ;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 Q 12 PRINTER ;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^GMRAPST5",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 16 . S ZTDESC="Reported Reaction over a date range." 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 Q 21 PRINT ;Queue point for report 22 ;loop through the 120.85 file and look for the field that 23 D NOW^%DTC S GMRADPDT=X 24 S GMRADATE=GMAST-.0001,GMRAPG=1 25 S GMRATOT=0 26 F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D 27 .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D 28 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node 29 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;Entered in Error Data 30 ..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2)) ;GMRA*4*33 Exclude test patient from report if production or legacy environment. 31 ..S GMRATOT=GMRATOT+1 32 ..Q 33 .Q 34 Q:GMRAOUT 35 D HEAD 36 W !,?19,"Total Number of Reported Reactions: ",GMRATOT 37 W !,?27,"From: ",$$FMTE^XLFDT(GMAST,"2D"),?42,"To: ",$$FMTE^XLFDT(GMAEN,"2D") 38 D CLOSE^GMRAUTL 39 Q 40 ;has the patient died within the date 41 HEAD ; Print header information 42 I GMRAPG'=1 Q:$Y<(IOSL-4) 43 I $E(IOST,1)="C" D Q:GMRAOUT 44 .I GMRAPG=1 W @IOF Q 45 .I GMRAPG'=1 D Q:GMRAOUT 46 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 47 ..K Y 48 ..Q 49 .Q 50 Q:GMRAOUT 51 I GMRAPG'=1 W @IOF 52 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 53 W !,?33,"Reported Reactions" 54 W !,$$REPEAT^XLFSTR("-",79) 55 S GMRAPG=GMRAPG+1 56 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 57 Q 1 GMRAPST5 ;HIRMFO/WAA- PRINT TOTAL NUMBER OF REPORTED REACTION ;3/5/97 15:16 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 Q 12 PRINTER ;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^GMRAPST5",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 16 . S ZTDESC="Reported Reaction over a date range." 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 Q 21 PRINT ;Queue point for report 22 ;loop through the 120.85 file and look for the field that 23 D NOW^%DTC S GMRADPDT=X 24 S GMRADATE=GMAST-.0001,GMRAPG=1 25 S GMRATOT=0 26 F S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1 Q:GMRADATE>GMAEN D 27 .S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1 D 28 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)="" ;Bad Node 29 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER")) ;Entered in Error Data 30 ..S GMRATOT=GMRATOT+1 31 ..Q 32 .Q 33 Q:GMRAOUT 34 D HEAD 35 W !,?19,"Total Number of Reported Reactions: ",GMRATOT 36 W !,?27,"From: ",$$FMTE^XLFDT(GMAST,"2D"),?42,"To: ",$$FMTE^XLFDT(GMAEN,"2D") 37 D CLOSE^GMRAUTL 38 Q 39 ;has the patient died with inthe dat 40 HEAD ; Print header information 41 I GMRAPG'=1 Q:$Y<(IOSL-4) 42 I $E(IOST,1)="C" D Q:GMRAOUT 43 .I GMRAPG=1 W @IOF Q 44 .I GMRAPG'=1 D Q:GMRAOUT 45 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 46 ..K Y 47 ..Q 48 .Q 49 Q:GMRAOUT 50 I GMRAPG'=1 W @IOF 51 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 52 W !,?33,"Reported Reactions" 53 W !,$$REPEAT^XLFSTR("-",79) 54 S GMRAPG=GMRAPG+1 55 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 56 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST6.m
r613 r623 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 1 GMRAPST6 ;HIRMFO/WAA- ADR OUTCOME REPORT ;3/5/97 15:16 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,"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 ..S ^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)="" 37 ..Q 38 .Q 39 Q:GMRAOUT 40 I '$D(^TMP($J,"GMRAPST6")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q 41 S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0))) 42 S GMRADDT=0 43 F S GMRADDT=$O(^TMP($J,"GMRAPST6",GMRADDT)) Q:GMRADDT<1 D Q:GMRAOUT 44 .S GMRACA="" 45 .F S GMRACA=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA)) Q:GMRACA="" D Q:GMRAOUT 46 ..S GMRAPA1=0 47 ..F S GMRAPA1=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT 48 ...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) 49 ...Q:GMRAPA(0)="" 50 ...D HEAD Q:GMRAOUT 51 ...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date 52 ...W ?8,"|",GMRACA ; Causative Agent 53 ...W ?38,"|" 54 ...S GMRAREC=0 55 ...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC) 56 ...W ?58,"|" W:$P(GMRAPA1(0),U,4)="y" " Y" ; Req Tx with Rx 57 ...W ?63,"|" W:$P(GMRAPA1(0),U,7)="y" " Y" ; Req Hosp. 58 ...W ?68,"|" W:$P(GMRAPA1(0),U,10)="y" " Y" ; Disability 59 ...W ?73,"|" W:$P(GMRAPA1(0),U,3)="y" " Y" ; Death 60 ...F S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1 D SIGN("1",GMRAREC) Q:GMRAOUT 61 ...Q:GMRAOUT 62 ...D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|",?73,"|" 63 ...Q 64 ..Q 65 .Q 66 D CLOSE^GMRAUTL 67 Q 68 SIGN(CNT,GMRAREC) ; Print Sign/Symptoms 69 N NAM,Y 70 S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0)) 71 S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"") 72 I 'CNT W $E(NAM,1,19) 73 E D HEAD Q:GMRAOUT W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|",?73,"|" 74 Q 75 HEAD ; Print header information 76 I GMRAPG'=1 Q:$Y<(IOSL-4) 77 I $E(IOST,1)="C" D Q:GMRAOUT 78 .I GMRAPG=1 W @IOF Q 79 .I GMRAPG'=1 D Q:GMRAOUT 80 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 81 ..K Y 82 ..Q 83 .Q 84 Q:GMRAOUT 85 I GMRAPG'=1 W @IOF 86 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG 87 W !,?22,"P&T Committee ADR Outcome Report" 88 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D") 89 W !,$$REPEAT^XLFSTR("-",79) 90 W !,"Obsv.",?8,"|",?38,"|",?58,"|Req.",?63,"|Req.",?68,"|",?73,"|" 91 W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Tx",?63,"|Hosp",?68,"|Dis.",?73,"|Death" 92 W !,$$REPEAT^XLFSTR("-",79) 93 S GMRAPG=GMRAPG+1 94 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 95 Q -
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 -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPU.m
r613 r623 1 GMRAPU ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION UNVERIFIED ;8/27/93 2 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5 3 EN1 ; This routine will loop through the GMRA patient allergy file (120.8) 4 ; to find all patients with unverified reactions 5 ; 6 S GMRAOUT=0 D PRINTER 7 EXIT ; Exit of program kill cleanup 8 D KILL^XUSCLEAN 9 K ^TMP($J,"GMRAPU") 10 Q 11 PRINTER ;Select printer 12 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 13 I $D(IO("Q")) D Q 14 . S ZTRTN="PRINT^GMRAPU",ZTSAVE("GMRAOUT")="" 15 . S ZTDESC="List of Unverified Reactions by Ward Location" D ^%ZTLOAD 16 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 17 . Q 18 U IO D PRINT U IO(0) 19 Q 20 PRINT ;Queue point for report 21 K ^TMP($J,"GMRAPU") D FIND 22 REPORT ; Print out the report 23 S GMRAOUT=$G(GMRAOUT) 24 S GMALOC="",GMRAPG=1,GMRADATE=$$NOW^XLFDT 25 I '$D(^TMP($J,"GMRAPU")) D HEAD W !,?20,"NO DATA FOR THIS REPORT" 26 F S GMALOC=$O(^TMP($J,"GMRAPU",GMALOC)) Q:GMALOC="" D HEAD Q:GMRAOUT D Q:GMRAOUT 27 .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT 28 ..S GMADFN=0 F S GMADFN=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN)) Q:GMADFN<1 D Q:GMRAOUT 29 ...S GMRASSN="",GMRARB="" 30 ...D VAD^GMRAUTL1(GMADFN,"","","","",.GMRASSN,.GMRARB) 31 ...W !,GMRARB,$S(GMRARB'="":" ",1:""),GMRANAM," (",GMRASSN,")" 32 ...S GMADT=0 F S GMADT=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT)) Q:GMADT<1 S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT 33 ....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 34 ....Q:GMRAPA(0)="" 35 ....W !,?3,$$FMTE^XLFDT(GMADT,"1") 36 ....W ?30,$S($P(GMRAPA(0),U,5)'="":$E($P($G(^VA(200,$P(GMRAPA(0),U,5),0)),U),1,24),1:"<None>") 37 ....W ?55,$E($P(GMRAPA(0),U,2),1,24) 38 ....I $Y>(IOSL-4) D HEAD 39 ....Q 40 ...Q 41 ..Q 42 .Q 43 D CLOSE^GMRAUTL 44 Q 45 HEAD ; Print header information 46 I $E(IOST,1)="C" D Q:GMRAOUT 47 .I GMRAPG=1 W @IOF Q 48 .I GMRAPG'=1 D Q:GMRAOUT 49 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 50 ..K Y 51 ..Q 52 .Q 53 Q:GMRAOUT 54 I GMRAPG'=1 W @IOF 55 W "Report Date: ",$P($$FMTE^XLFDT(GMRADATE),"@"),?70,"Page: ",GMRAPG 56 W !,?19,"List of Unverified Reactions by Ward Location" 57 W !,?30,"Ward Location: ",GMALOC 58 W !,?3,"Origination Date/Time",?30,"Originator",?55,"Reaction" 59 W !,$$REPEAT^XLFSTR("-",78) 60 S GMRAPG=GMRAPG+1 61 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 62 Q 63 FIND ; This subroutines will build the data for the report. 64 N GMADFN 65 S GMADFN=0 66 F S GMADFN=$O(^GMR(120.8,"AVER",GMADFN)) Q:GMADFN<1 D 67 .N GMRALOC,GMRANAM,GMALOC,GMRAPA 68 .S GMRANAM="",GMRALOC="" 69 .Q:'$$PRDTST^GMRAUTL1(GMADFN) ;GMRA*4*33 Exclude test patients if production or legacy environment. 70 .D VAD^GMRAUTL1(GMADFN,"",.GMRALOC,.GMRANAM,"","","") I GMRALOC="" S GMALOC="OUTPATIENT" 71 .E S GMALOC=$P($G(^DIC(42,GMRALOC,0)),U) 72 .Q:GMALOC="" 73 .S GMRAPA=0 74 .F S GMRAPA=$O(^GMR(120.8,"AVER",GMADFN,GMRAPA)) Q:GMRAPA<1 D 75 ..N GMADT 76 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 77 ..S GMADT=$P(GMRAPA(0),U,4) 78 ..S ^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)="" 79 ..Q 80 .Q 81 Q 1 GMRAPU ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION UNVERIFIED ; 8/27/93 2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 3 EN1 ; This routine will loop through the GMRA patient allergy file (120.8) 4 ; to find all patients with unverified reactions 5 ; 6 S GMRAOUT=0 D PRINTER 7 EXIT ; Exit of program kill cleanup 8 D KILL^XUSCLEAN 9 K ^TMP($J,"GMRAPU") 10 Q 11 PRINTER ;Select printer 12 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 13 I $D(IO("Q")) D Q 14 . S ZTRTN="PRINT^GMRAPU",ZTSAVE("GMRAOUT")="" 15 . S ZTDESC="List of Unverified Reactions by Ward Location" D ^%ZTLOAD 16 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 17 . Q 18 U IO D PRINT U IO(0) 19 Q 20 PRINT ;Queue point for report 21 K ^TMP($J,"GMRAPU") D FIND 22 REPORT ; Print out the report 23 S GMRAOUT=$G(GMRAOUT) 24 S GMALOC="",GMRAPG=1,GMRADATE=$$NOW^XLFDT 25 I '$D(^TMP($J,"GMRAPU")) D HEAD W !,?20,"NO DATA FOR THIS REPORT" 26 F S GMALOC=$O(^TMP($J,"GMRAPU",GMALOC)) Q:GMALOC="" D HEAD Q:GMRAOUT D Q:GMRAOUT 27 .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT 28 ..S GMADFN=0 F S GMADFN=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN)) Q:GMADFN<1 D Q:GMRAOUT 29 ...S GMRASSN="",GMRARB="" 30 ...D VAD^GMRAUTL1(GMADFN,"","","","",.GMRASSN,.GMRARB) 31 ...W !,GMRARB,$S(GMRARB'="":" ",1:""),GMRANAM," (",GMRASSN,")" 32 ...S GMADT=0 F S GMADT=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT)) Q:GMADT<1 S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT 33 ....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 34 ....Q:GMRAPA(0)="" 35 ....W !,?3,$$FMTE^XLFDT(GMADT,"1") 36 ....W ?30,$S($P(GMRAPA(0),U,5)'="":$E($P($G(^VA(200,$P(GMRAPA(0),U,5),0)),U),1,24),1:"<None>") 37 ....W ?55,$E($P(GMRAPA(0),U,2),1,24) 38 ....I $Y>(IOSL-4) D HEAD 39 ....Q 40 ...Q 41 ..Q 42 .Q 43 D CLOSE^GMRAUTL 44 Q 45 HEAD ; Print header information 46 I $E(IOST,1)="C" D Q:GMRAOUT 47 .I GMRAPG=1 W @IOF Q 48 .I GMRAPG'=1 D Q:GMRAOUT 49 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 50 ..K Y 51 ..Q 52 .Q 53 Q:GMRAOUT 54 I GMRAPG'=1 W @IOF 55 W "Report Date: ",$P($$FMTE^XLFDT(GMRADATE),"@"),?70,"Page: ",GMRAPG 56 W !,?19,"List of Unverified Reactions by Ward Location" 57 W !,?30,"Ward Location: ",GMALOC 58 W !,?3,"Origination Date/Time",?30,"Originator",?55,"Reaction" 59 W !,$$REPEAT^XLFSTR("-",78) 60 S GMRAPG=GMRAPG+1 61 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 62 Q 63 FIND ; This subroutines will build the data for the report. 64 N GMADFN 65 S GMADFN=0 66 F S GMADFN=$O(^GMR(120.8,"AVER",GMADFN)) Q:GMADFN<1 D 67 .N GMRALOC,GMRANAM,GMALOC,GMRAPA 68 .S GMRANAM="",GMRALOC="" 69 .D VAD^GMRAUTL1(GMADFN,"",.GMRALOC,.GMRANAM,"","","") I GMRALOC="" S GMALOC="OUTPATIENT" 70 .E S GMALOC=$P($G(^DIC(42,GMRALOC,0)),U) 71 .Q:GMALOC="" 72 .S GMRAPA=0 73 .F S GMRAPA=$O(^GMR(120.8,"AVER",GMADFN,GMRAPA)) Q:GMRAPA<1 D 74 ..N GMADT 75 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 76 ..S GMADT=$P(GMRAPA(0),U,4) 77 ..S ^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)="" 78 ..Q 79 .Q 80 Q -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAUTL1.m
r613 r623 1 GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ;12/04/92 2 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5 3 ; 4 ; Reference to $$PROD^XUPROD supported by DBIA 4440 5 ; Reference to $$TESTPAT^VADPT supported by DBIA 3744 6 ; 7 Q 8 STPCK() ; This is to check to see if the user wanted to stop the print 9 S ZTSTOP=0 10 I $$S^%ZTLOAD D 11 .S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***" 12 .Q 13 Q ZTSTOP 14 BR ; This is a online reference card entry point 15 I '$$TEST^DDBRT D Q 16 .W $C(7) 17 .W !,?20,"Your Terminal cannot display this Reference Card." 18 .W !,?20,"Please contact IRM Service to correct this problem." 19 .Q 20 N X 21 S X=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) Q:X<1 22 D WP^DDBR(120.87,X,1) 23 Q 24 PR ; This is a print utility for the reference card for IRM 25 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 26 I $D(IO("Q")) D Q 27 . S ZTRTN="PR1^GMRAUTL1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 28 . S ZTDESC="Print reference card" D ^%ZTLOAD 29 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 30 . Q 31 U IO D PR1 U IO(0) 32 Q 33 PR1 ; Print out the card 34 N GMRAOUT,GMRACD,GMRALN,X 35 I $E(IOST,1)="C" W @IOF 36 S GMRACD=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) 37 S (GMRAOUT,GMRALN)=0 38 LP1 ; Main loop 39 F S GMRALN=$O(^GMRD(120.87,GMRACD,1,GMRALN)) Q:GMRALN<1 D Q:GMRAOUT 40 .S X=$G(^GMRD(120.87,GMRACD,1,GMRALN,0)) 41 .W !,X 42 .I $Y>(IOSL-4) D 43 ..I $E(IOST,1)="C" N DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E" D ^DIR S:$D(DIRUT) GMRAOUT=1 W:'GMRAOUT @IOF Q 44 ..W @IOF 45 ..Q 46 .Q 47 D CLOSE^GMRAUTL 48 Q 49 PRDTST(GMRADFN) ; GMRA*4*33 - Remove Test Patients from Live Reports 50 ; This function will return 0 if the patient should not print on the report, and 1 if the patient 51 ; should appear on the report. This function will allow all patients to print on the report if the 52 ; report is run in a test environment. 53 ; 54 I GMRADFN="" Q 0 ;DFN not defined. Should never be the case. 55 I '$$PROD^XUPROD() Q 1 ;Not a production or legacy environment. Print all patients on report. 56 I $$TESTPAT^VADPT(GMRADFN) Q 0 ;Production or legacy environment. Test patient. Do not print on report. 57 Q 1 ;Production or legacy environment. Not a test patient. Print on report. 58 ; 59 VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID) ; Call to VADPT 60 ; This call is a generic call to 1^VADPT 61 ; Input: 62 ; 1 DFN = Patient Internal entry number in the Patient File 63 ; 2 DAT = Date for lookup 64 ; 65 ; Output: 66 ; 3 LOC = Hospital Location 67 ; 4 NAM = Full Patient name 68 ; 5 SEX = Patient SEX 69 ; 6 SSN = Patient SSN 70 ; 7 RB = Patient Room Bed 71 ; 8 PRO = Patient Provider 72 ; 9 PID = Patient ID 73 ; 74 S DFN=$G(DFN) Q:DFN="" 75 S VAINDT=$G(DAT) I VAINDT="" K VAINDT 76 D 1^VADPT 77 S LOC=$P(VAIN(4),U),NAM=VADM(1),SEX=VADM(5) 78 S SSN=$P(VADM(2),U,2),RB=VAIN(5),PID=VA("PID") 79 S PRO=$P(VAIN(2),U,2) 80 D KVAR^VADPT K VA,VAROOT 81 Q 82 DATE(DATE) ; This Ex-Function will date the date from the DATE 83 ; and convert it to the old DD("DD") style format 84 ; it returns the answer in DATE 85 N Y 86 S Y=$$FMTE^XLFDT(DATE,1) 87 S DATE=$P(Y," ")_" "_(+$P($P(Y,",")," ",2))_","_$P(Y," ",3) 88 Q DATE 1 GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ; 12/04/92 2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 3 Q 4 STPCK() ; This is to check to see if the user wanted to stop the print 5 S ZTSTOP=0 6 I $$S^%ZTLOAD D 7 .S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***" 8 .Q 9 Q ZTSTOP 10 BR ; This is a online reference card entry point 11 I '$$TEST^DDBRT D Q 12 .W $C(7) 13 .W !,?20,"Your Terminal cannot display this Reference Card." 14 .W !,?20,"Please contact IRM Service to correct this problem." 15 .Q 16 N X 17 S X=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) Q:X<1 18 D WP^DDBR(120.87,X,1) 19 Q 20 PR ; This is a print utility for the reference card for IRM 21 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 22 I $D(IO("Q")) D Q 23 . S ZTRTN="PR1^GMRAUTL1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))="" 24 . S ZTDESC="Print reference card" D ^%ZTLOAD 25 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 26 . Q 27 U IO D PR1 U IO(0) 28 Q 29 PR1 ; Print out the card 30 N GMRAOUT,GMRACD,GMRALN,X 31 I $E(IOST,1)="C" W @IOF 32 S GMRACD=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) 33 S (GMRAOUT,GMRALN)=0 34 LP1 ; Main loop 35 F S GMRALN=$O(^GMRD(120.87,GMRACD,1,GMRALN)) Q:GMRALN<1 D Q:GMRAOUT 36 .S X=$G(^GMRD(120.87,GMRACD,1,GMRALN,0)) 37 .W !,X 38 .I $Y>(IOSL-4) D 39 ..I $E(IOST,1)="C" N DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E" D ^DIR S:$D(DIRUT) GMRAOUT=1 W:'GMRAOUT @IOF Q 40 ..W @IOF 41 ..Q 42 .Q 43 D CLOSE^GMRAUTL 44 Q 45 VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID) ; Call to VADPT 46 ; This call is a generic call to 1^VADPT 47 ; Input: 48 ; 1 DFN = Patient Internal entry number in the Patient File 49 ; 2 DAT = Date for lookup 50 ; 51 ; Output: 52 ; 3 LOC = Hospital Location 53 ; 4 NAM = Full Patient name 54 ; 5 SEX = Patient SEX 55 ; 6 SSN = Patient SSN 56 ; 7 RB = Patient Room Bed 57 ; 8 PRO = Patient Provider 58 ; 9 PID = Patient ID 59 ; 60 S DFN=$G(DFN) Q:DFN="" 61 S VAINDT=$G(DAT) I VAINDT="" K VAINDT 62 D 1^VADPT 63 S LOC=$P(VAIN(4),U),NAM=VADM(1),SEX=VADM(5) 64 S SSN=$P(VADM(2),U,2),RB=VAIN(5),PID=VA("PID") 65 S PRO=$P(VAIN(2),U,2) 66 D KVAR^VADPT K VA,VAROOT 67 Q 68 DATE(DATE) ; This Ex-Function will date the date from the DATE 69 ; and convert it to the old DD("DD") style format 70 ; it returns the answer in DATE 71 N Y 72 S Y=$$FMTE^XLFDT(DATE,1) 73 S DATE=$P(Y," ")_" "_(+$P($P(Y,",")," ",2))_","_$P(Y," ",3) 74 Q DATE -
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAVFY.m
r613 r623 1 GMRAVFY ;HIRMFO/WAA,PWC-VERIFY AND SIGN OFF AN AGENT ; 5/23/07 10:32am 2 ;;4.0;Adverse Reaction Tracking;**2,33**;Mar 29, 1996;Build 5 3 EN1 ;This is the main entry point for the verifier option. 4 S GMRAVER=0,GMRADRUG=0 5 I $P(GMRAPA(0),U,20)'["D" S GMRAFLAG=0 G VERIFY 6 S GMRAFLAG=1,GMRADRUG=1 7 I $P(GMRAPA(0),U,6)'="o" G VERIFY 8 I '$D(GMRASITE) D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,GMRASITE,0)) 9 I $P(^GMRD(120.84,+GMRASITE,0),U,7)'="y" G VERIFY 10 I $D(^GMR(120.85,"C",GMRAPA)) G VERIFY 11 W !,"Since this Causative Agent is an observed drug reaction and" 12 W !,"FDA Data is required you must enter the Observer information" 13 W !,"prior to verification." 14 G EXIT 15 VERIFY ;Verify an agent 16 W !!,"Currently you have verifier access." 17 F W !,"Would you like to verify this Causative Agent now" S %=1 D YN^DICN Q:%'=0 W !?4,"ANSWER YES IF YOU WOULD LIKE TO VERIFY THIS DATA, ELSE ANSWER NO." 18 S:%=-1 GMRAOUT=1 G EXIT:%'=1 S GMRAVFY=1 W @IOF,! D SITE^GMRAUTL,EN2^GMRAPEV0 K GMRAVFY G:GMRAOUT EXIT 19 I GMRAVER S GMRANAME=$P($G(^DPT(+GMRAPA(0),0)),U),GMRALLER=$P(GMRAPA(0),U,2) K:GMRANAME]""&(GMRALLER]"") ^TMP($J,"GMRADSP",GMRANAME,GMRALLER,GMRAPA) K ^TMP("GMRA",$J) 20 I 'GMRAVER!GMRAOUT G EXIT 21 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 22 I '$P(GMRAPA(0),U,12) S DA=GMRAPA,DIE="^GMR(120.8,",DR="15////1" D ^DIE D ; Execute the event point for this reaction 23 .Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 24 .N OROLD,DFN,GMRACNT S DFN=$P(GMRAPA(0),U) 25 .D INP^VADPT S X=$O(^ORD(101,"B","GMRA SIGN-OFF ON DATA",0))_";ORD(101," D EN^XQOR:X K VAIN,X 26 .Q 27 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)),GMRATYPE=$P(GMRAPA(0),U,20) 28 S DA=GMRAPA,DIE="^GMR(120.8,",DR="19////1;20///N;21////"_DUZ D ^DIE D:'GMRAVER EN1^GMRAVAB S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"") 29 I $G(GMRANEW) D ;send NOTIFICATION bulletin if this is new -- GMRA*4*33 30 . I $P(GMRAPA(0),U,6)="o",GMRATYPE["D" D PTBUL^GMRAROBS 31 I GMRAVER D EN1^GMRAPET0($P(GMRAPA(0),U),GMRAPA,"V",.GMRAOUT) I GMRAOUT S GMRAOUT=0 32 Q1 D UNLOCK^GMRAUTL(120.8,GMRAPA) 33 EXIT K GMRAFLAG,DA,DIE,DR,GMRADRUG Q 1 GMRAVFY ;HIRMFO/WAA-VERIFY AND SIGN OFF AN AGENT ;12/1/95 16:06 2 ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996 3 EN1 ;This is the main entry point for the verifier option. 4 S GMRAVER=0,GMRADRUG=0 5 I $P(GMRAPA(0),U,20)'["D" S GMRAFLAG=0 G VERIFY 6 S GMRAFLAG=1,GMRADRUG=1 7 I $P(GMRAPA(0),U,6)'="o" G VERIFY 8 I '$D(GMRASITE) D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,GMRASITE,0)) 9 I $P(^GMRD(120.84,+GMRASITE,0),U,7)'="y" G VERIFY 10 I $D(^GMR(120.85,"C",GMRAPA)) G VERIFY 11 W !,"Since this Causative Agent is an observed drug reaction and" 12 W !,"FDA Data is required you must enter the Observer information" 13 W !,"prior to verification." 14 G EXIT 15 VERIFY ;Verify an agent 16 W !!,"Currently you have verifier access." 17 F W !,"Would you like to verify this Causative Agent now" S %=1 D YN^DICN Q:%'=0 W !?4,"ANSWER YES IF YOU WOULD LIKE TO VERIFY THIS DATA, ELSE ANSWER NO." 18 S:%=-1 GMRAOUT=1 G EXIT:%'=1 S GMRAVFY=1 W @IOF,! D SITE^GMRAUTL,EN2^GMRAPEV0 K GMRAVFY G:GMRAOUT EXIT 19 I GMRAVER S GMRANAME=$P($G(^DPT(+GMRAPA(0),0)),U),GMRALLER=$P(GMRAPA(0),U,2) K:GMRANAME]""&(GMRALLER]"") ^TMP($J,"GMRADSP",GMRANAME,GMRALLER,GMRAPA) K ^TMP("GMRA",$J) 20 I 'GMRAVER!GMRAOUT G EXIT 21 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 22 I '$P(GMRAPA(0),U,12) S DA=GMRAPA,DIE="^GMR(120.8,",DR="15////1" D ^DIE D ; Execute the event point for this reaction 23 .Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 24 .N OROLD,DFN,GMRACNT S DFN=$P(GMRAPA(0),U) 25 .D INP^VADPT S X=$O(^ORD(101,"B","GMRA SIGN-OFF ON DATA",0))_";ORD(101," D EN^XQOR:X K VAIN,X 26 .Q 27 S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)),GMRATYPE=$P(GMRAPA(0),U,20) 28 S DA=GMRAPA,DIE="^GMR(120.8,",DR="19////1;20///N;21////"_DUZ D ^DIE D:'GMRAVER EN1^GMRAVAB S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"") 29 I $P(GMRAPA(0),U,6)="o",GMRATYPE["D" D PTBUL^GMRAROBS 30 I GMRAVER D EN1^GMRAPET0($P(GMRAPA(0),U),GMRAPA,"V",.GMRAOUT) I GMRAOUT S GMRAOUT=0 31 Q1 D UNLOCK^GMRAUTL(120.8,GMRAPA) 32 EXIT K GMRAFLAG,DA,DIE,DR,GMRADRUG Q
Note:
See TracChangeset
for help on using the changeset viewer.
