source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXX2.m@ 1800

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

initial load of WorldVistAEHR

File size: 5.3 KB
RevLine 
[613]1PXRMXX2 ; SLC/PJH - Build list of reminder findings;08/25/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Called at HF, PED, LAB and POV from PXRMXX
5 ;
6HF(BEGIN,END,HFS,NMSPACE) ; return patients with health factors
7 N DATA,DFN,ERR,HF,RBEGIN,REND,TEMP K DATA,ERR
8 I '$O(HFS(0)) Q
9 I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
10 I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
11 D HFDATA(.HFS,.DATA,.ERR)
12 S RBEGIN=9999999-BEGIN,REND=9999999-END
13 S DFN=0 F S DFN=$O(^AUPNVHF("AA",DFN)) Q:DFN<1 D
14 .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
15 .I $$HFCHECK(DFN,.DATA,RBEGIN,REND) D
16 ..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
17 Q
18 ;
19HFDATA(HFS,DATA,ERR) ;
20 N HF,HFNAME,ZERO K ERR
21 S HF=0 F S HF=$O(HFS(HF)) Q:HF<1 D
22 .S ZERO=$G(^AUTTHF(HF,0)) I '$L(ZERO) Q
23 .S HFNAME=$P(ZERO,U)
24 .S DATA(HF)=HFNAME
25 Q
26 ;
27HFCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if health factor else 0
28 N HF,OK,TIME
29 S OK=0
30 S HF=0 F S HF=$O(DATA(HF)) Q:HF<1 D
31 .S TIME=RBEGIN F S TIME=$O(^AUPNVHF("AA",DFN,HF,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
32 ..S OK=1
33 Q OK
34 ;
35PED(BEGIN,END,PEDS,NMSPACE) ; return patients with education
36 N DATA,DFN,ERR,PED,RBEGIN,REND,TEMP K DATA,ERR
37 I '$O(PEDS(0)) Q
38 I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
39 I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
40 D PEDDATA(.PEDS,.DATA,.ERR)
41 S RBEGIN=9999999-BEGIN,REND=9999999-END
42 S DFN=0 F S DFN=$O(^AUPNVPED("AA",DFN)) Q:DFN<1 D
43 .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
44 .I $$PEDCHECK(DFN,.DATA,RBEGIN,REND) D
45 ..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
46 Q
47 ;
48PEDDATA(PEDS,DATA,ERR) ;
49 N PED,PEDNAME,ZERO K ERR
50 S PED=0 F S PED=$O(PEDS(PED)) Q:PED<1 D
51 .S ZERO=$G(^AUTTEDT(PED,0)) I '$L(ZERO) Q
52 .S PEDNAME=$P(ZERO,U)
53 .S DATA(PED)=PEDNAME
54 Q
55 ;
56PEDCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if education topic else 0
57 N PED,OK,TIME
58 S OK=0
59 S PED=0 F S PED=$O(DATA(PED)) Q:PED<1 D
60 .S TIME=RBEGIN F S TIME=$O(^AUPNVPED("AA",DFN,PED,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
61 ..S OK=1
62 Q OK
63 ;
64EXAM(BEGIN,END,XAMS,NMSPACE) ; return patients with education
65 N DATA,DFN,ERR,RBEGIN,REND,TEMP,XAM K DATA,ERR
66 I '$O(XAMS(0)) Q
67 I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
68 I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
69 D EXAMDATA(.XAMS,.DATA,.ERR)
70 S RBEGIN=9999999-BEGIN,REND=9999999-END
71 S DFN=0 F S DFN=$O(^AUPNVXAM("AA",DFN)) Q:DFN<1 D
72 .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
73 .I $$EXAMCHEK(DFN,.DATA,RBEGIN,REND) D
74 ..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
75 Q
76 ;
77EXAMDATA(XAMS,DATA,ERR) ;
78 N XAM,XAMNAME,ZERO K ERR
79 S XAM=0 F S XAM=$O(XAMS(XAM)) Q:XAM<1 D
80 .S ZERO=$G(^AUTTEXAM(XAM,0)) I '$L(ZERO) Q
81 .S XAMNAME=$P(ZERO,U)
82 .S DATA(XAM)=XAMNAME
83 Q
84 ;
85EXAMCHEK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if examination else 0
86 N XAM,OK,TIME
87 S OK=0
88 S XAM=0 F S XAM=$O(DATA(XAM)) Q:XAM<1 D
89 .S TIME=RBEGIN F S TIME=$O(^AUPNVXAM("AA",DFN,XAM,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
90 ..S OK=1
91 Q OK
92 ;
93 ;
94LAB(BEGIN,END,TESTS,NMSPACE) ; return patients with lab results
95 N DATA,DFN,ERR,RBEGIN,REND,TEMP,TEST K DATA,ERR
96 S BEGIN=+$G(BEGIN),END=+$G(END)
97 I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
98 I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
99 D LABDATA(.TESTS,.DATA,.ERR)
100 S RBEGIN=9999999-BEGIN,REND=9999999-END
101 S DFN=0 F S DFN=$O(^DPT(DFN)) Q:DFN<1 D
102 .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
103 .I $$LABCHECK(DFN,.DATA,RBEGIN,REND) D
104 ..S ^TMP(NMSPACE,$J,"TEMP",DFN)="" ;***S CNT=CNT+1
105 Q
106 ;
107LABDATA(TESTS,DATA,ERR) ;
108 N DNODE,TEST,TESTNAME,ZERO K ERR
109 S TEST=0 F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
110 .S ZERO=$G(^LAB(60,TEST,0))
111 .I '$L(ZERO) Q
112 .S DNODE=+$P($P(ZERO,U,5),";",2)
113 .S TESTNAME=$P(ZERO,U)
114 .I 'DNODE Q
115 .S DATA(DNODE)=TESTNAME
116 Q
117 ;
118LABCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if lab result else 0
119 N DNODE,LRDFN,OK,TIME
120 S OK=0
121 S LRDFN=+$G(^DPT(DFN,"LR"))
122 I 'LRDFN Q OK
123 S TIME=RBEGIN F S TIME=$O(^LR(LRDFN,"CH",TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
124 .S DNODE=0 F S DNODE=$O(DATA(DNODE)) Q:DNODE<1 D I OK Q
125 ..I $D(^LR(LRDFN,"CH",TIME,DNODE)) D
126 ...I '$P($G(^LR(LRDFN,"CH",TIME,0)),U,3) Q ; test must be completed
127 ...S OK=1
128 Q OK
129 ;
130POV(BEGIN,END,INPUT,NMSPACE) ; return patients with diagnosis
131 I INPUT=NMSPACE Q
132 N DATA,DFN,ERR,POV,RBEGIN,REND,TEMP K DATA,ERR
133 S BEGIN=+$G(BEGIN),END=+$G(END)
134 I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
135 I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
136 D POVDATA(.INPUT,.ERR)
137 S RBEGIN=9999999-BEGIN,REND=9999999-END
138 S DFN=0 F S DFN=$O(^AUPNVPOV("AA",DFN)) Q:DFN<1 D
139 .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
140 .S:$$POVCHECK(DFN,INPUT,RBEGIN,REND) ^TMP(NMSPACE,$J,"TEMP",DFN)=""
141 K ^TMP(INPUT,$J)
142 Q
143 ;
144POVDATA(INPUT,ERR) ;
145 N NEWINPUT,POV,POVNAME,ZERO K ERR
146 S NEWINPUT=INPUT_"ZZ"
147 K ^TMP(NEWINPUT,$J)
148 S POV=0 F S POV=$O(^TMP(INPUT,$J,POV)) Q:POV<1 D
149 .;S ZERO=$G(^ICD9(POV,0)) I '$L(ZERO) Q
150 .S ZERO=$$ICDDX^ICDCODE(POV) I '$L(ZERO) Q
151 .S ^TMP(NEWINPUT,$J,POV)=$P(ZERO,U,2)
152 K ^TMP(INPUT,$J)
153 S INPUT=NEWINPUT
154 Q
155 ;
156POVCHECK(DFN,INPUT,RBEGIN,REND) ; $$ -> 1 if problem else 0
157 N POV,OK,TIME,IEN
158 S OK=0
159 S TIME=RBEGIN F S TIME=$O(^AUPNVPOV("AA",DFN,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
160 .S IEN=0 F S IEN=$O(^AUPNVPOV("AA",DFN,TIME,IEN)) Q:IEN<1 D
161 ..S POV=+$G(^AUPNVPOV(IEN,0)) I 'POV Q
162 ..S:$D(^TMP(INPUT,$J,POV)) OK=1
163 Q OK
Note: See TracBrowser for help on using the repository browser.