- 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/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
Note:
See TracChangeset
for help on using the changeset viewer.
