- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/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
Note:
See TracChangeset
for help on using the changeset viewer.
