source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXX2T.m@ 846

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1PXRMXX2T ; SLC/PJH - Build list of reminder findings;08/15/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 ;
64 ;
65LAB(BEGIN,END,TESTS,NMSPACE) ; return patients with lab results
66 N DATA,DFN,ERR,RBEGIN,REND,TEMP,TEST K DATA,ERR
67 S BEGIN=+$G(BEGIN),END=+$G(END)
68 I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
69 I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
70 D LABDATA(.TESTS,.DATA,.ERR)
71 S RBEGIN=9999999-BEGIN,REND=9999999-END
72 S DFN=0 F S DFN=$O(^DPT(DFN)) Q:DFN<1 D
73 .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
74 .I $$LABCHECK(DFN,.DATA,RBEGIN,REND) D
75 ..S ^TMP(NMSPACE,$J,"TEMP",DFN)="" ;***S CNT=CNT+1
76 Q
77 ;
78LABDATA(TESTS,DATA,ERR) ;
79 N DNODE,TEST,TESTNAME,ZERO K ERR
80 S TEST=0 F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
81 .S ZERO=$G(^LAB(60,TEST,0))
82 .I '$L(ZERO) Q
83 .S DNODE=+$P($P(ZERO,U,5),";",2)
84 .S TESTNAME=$P(ZERO,U)
85 .I 'DNODE Q
86 .S DATA(DNODE)=TESTNAME
87 Q
88 ;
89LABCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if lab result else 0
90 N DNODE,LRDFN,OK,TIME
91 S OK=0
92 S LRDFN=+$G(^DPT(DFN,"LR"))
93 I 'LRDFN Q OK
94 S TIME=RBEGIN F S TIME=$O(^LR(LRDFN,"CH",TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
95 .S DNODE=0 F S DNODE=$O(DATA(DNODE)) Q:DNODE<1 D I OK Q
96 ..I $D(^LR(LRDFN,"CH",TIME,DNODE)) D
97 ...I '$P($G(^LR(LRDFN,"CH",TIME,0)),U,3) Q ; test must be completed
98 ...S OK=1
99 Q OK
100 ;
101POV(BEGIN,END,INPUT,NMSPACE) ; return patients with diagnosis
102 I INPUT=NMSPACE Q
103 N DATA,DFN,ERR,POV,RBEGIN,REND,TEMP K DATA,ERR
104 S BEGIN=+$G(BEGIN),END=+$G(END)
105 I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
106 I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
107 D POVDATA(.INPUT,.ERR)
108 S RBEGIN=9999999-BEGIN,REND=9999999-END
109 S DFN=0 F S DFN=$O(^AUPNVPOV("AA",DFN)) Q:DFN<1 D
110 .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
111 .S:$$POVCHECK(DFN,INPUT,RBEGIN,REND) ^TMP(NMSPACE,$J,"TEMP",DFN)=""
112 K ^TMP(INPUT,$J)
113 Q
114 ;
115POVDATA(INPUT,ERR) ;
116 N NEWINPUT,POV,POVNAME,ZERO K ERR
117 S NEWINPUT=INPUT_"ZZ"
118 K ^TMP(NEWINPUT,$J)
119 S POV=0 F S POV=$O(^TMP(INPUT,$J,POV)) Q:POV<1 D
120 .S ZERO=$G(^ICD9(POV,0)) I '$L(ZERO) Q
121 .S ^TMP(NEWINPUT,$J,POV)=$P(ZERO,U)
122 K ^TMP(INPUT,$J)
123 S INPUT=NEWINPUT
124 Q
125 ;
126POVCHECK(DFN,INPUT,RBEGIN,REND) ; $$ -> 1 if problem else 0
127 N POV,OK,TIME,IEN
128 S OK=0
129 S TIME=RBEGIN F S TIME=$O(^AUPNVPOV("AA",DFN,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
130 .S IEN=0 F S IEN=$O(^AUPNVPOV("AA",DFN,TIME,IEN)) Q:IEN<1 D
131 ..S POV=+$G(^AUPNVPOV(IEN,0)) I 'POV Q
132 ..S:$D(^TMP(INPUT,$J,POV)) OK=1
133 Q OK
Note: See TracBrowser for help on using the repository browser.