source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPNA.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1GMRAPNA ;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
3EN1 ; Entry for LIST BY LOCATION OF UNDOCUMENTED ALLERGIES option
4 D EN1^GMRACMR G:GMRAOUT EXIT
5 D DEV
6 D EXIT
7 Q
8DEV ; *** 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
22ENTSK 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
27PRINT ;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
50NOPAT ; 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
55HEAD ;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
72PRE ; 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
83EXIT ;
84 K ^TMP($J,"GMRAWC")
85 D KILL^XUSCLEAN
86 Q
Note: See TracBrowser for help on using the repository browser.