source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMGECV.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1PXRMGECV ;SLC/JVS -Extract data for GEC Reports ;7/14/05 10:46
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 Q
4 ;
5 ;Arrays
6 ;^TMP("PXRMGEC",$J, = Root Reference
7 ;"REF",DATE,DFN) = Number of HF in Referral
8 ;"REFDFN",DFN) = Number of Referrals per Patient
9 ;"HS" = Heath Summary Array
10 Q
11GEC ;Get ien for GEC Date Sources
12 S (GEC1DA,GEC2DA,GEC3DA,GECFDA)=0
13 S GECFDA=$O(^PX(839.7,"B","GECF",0))
14 S GEC1DA=$O(^PX(839.7,"B","GEC1",0))
15 S GEC2DA=$O(^PX(839.7,"B","GEC2",0))
16 S GEC3DA=$O(^PX(839.7,"B","GEC3",0))
17 Q
18 ;
19RANG(BDT,EDT,VDT,SDT,CHK) ;Dates are in date range
20 ;S=start date F=finished date
21 N OK,SOK,FOK
22 S (SOK,FOK,OK)=0
23 I CHK["S" D
24 .S:($P(SDT,".",1)'<(BDT))&($P(SDT,".",1)'>(EDT)) SOK=1
25 I CHK["F" D
26 .S:($P(VDT,".",1)'<(BDT))&($P(VDT,".",1)'>(EDT)) FOK=1
27 S OK=$S(SOK=1:1,FOK=1:1,1:0)
28 I CHK["SF"&(SOK+FOK'=2) S OK=0
29 Q OK
30 ;
31FIN(DATE,DFN) ;Check to see if finished
32 N GEC,DA,VST,VDT,DONE
33 S DONE=0,VDT="0000000",DA=0
34 S GEC=0 F S GEC=$O(^AUPNVHF("AED",DATE,DFN,GEC)) Q:GEC="" D
35 .I GEC=GECFDA S DONE=1 D
36 ..S DA=$O(^PXRMD(801.55,"AC",DFN,DATE,"GECF",0))
37 ..I DA>0 S VDT=$P($G(^PXRMD(801.55,DA,0)),"^",6)
38 ..;S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,0))
39 ..;S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
40 ..;S VDT=$P($G(^AUPNVSIT(VST,0)),"^",1)
41 ..;S VDT=DATE
42 Q DONE_"^"_VDT
43 ;
44E(ARY,FIN,BDT,EDT,CHK,DFNONLY) ;EXTRACT GEC REFERRALS
45 N DATE,GEC,DFN,DA,DFNX,DATEX,ZALL,CNTREF,COMPLETE
46 N REFERAL,REFERA,LOCA,LOCN,LOC,DOC,DOCT,DOCTN,DOCTNA
47 N DOCTOR,DR,DONE,VDT,FLAG,DTCHK,DATE1,DFN1,DATEY,DFNXX
48 N GEC1DA,GEC2DA,GEC3DA,GECFDA,DFNFLAG
49 ;N TMPLOC
50 ;====================================================
51 K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
52 ;====================================================
53 ;Callers Responsibility to Kill the Array
54 ;(ARY,FIN,BDT,EDT,CHK,DFNONLY)
55 ;EXAMPLE FOR HEALTH SUMMARY
56 ;D E^PXRMGECV("HS",2,3020509,3030609,"S",0)
57 ;Parameters
58 ;S ARY="HS"
59 ;Array to Create HS,DT,DFN,DOC,LOC,HFCD
60 ;S FIN=0
61 ;finished referrals 1=finished 0=unfinished 2=Both ""=finished
62 ;S BDT=3020509 Begin Date
63 ;S EDT=3030609 End Date
64 ;S CHK="S"
65 ;Check dates S=Start date Default F=Final date for date range
66 ;S DFNONLY=0
67 ; DFN of patient 0 or all
68 ;=====================================================
69 ;Count of Referrals
70 S CNTREF=0
71 D GEC ;get iens for the GECF VARIABLES
72 ;==============
73 D WORK
74 Q
75WORK ;
76 S DATE1=0,DFN1=0
77 S DATE="" F S DATE=$O(^AUPNVHF("AED",DATE)) Q:DATE="" D
78 .S DFN="" F S DFN=$O(^AUPNVHF("AED",DATE,DFN)) Q:DFN="" D
79 ..S COMPLETE=$$FIN(DATE,DFN),DONE=+COMPLETE,VDT=$P(COMPLETE,"^",2)
80 ..Q:FIN=1&(DONE=0)
81 ..Q:FIN=0&(DONE=1)
82 ..Q:'$$RANG(BDT,EDT,VDT,DATE,CHK)
83 ..;
84PAT ..;===Check Patient DFN to see if continue or quit
85 ..S DFNFLAG=1 I DFNONLY>0 D Q:DFNFLAG=0
86 ...I $D(DFNARY)&('$D(DFNARY(DFN))) S DFNFLAG=0
87 ...I '$D(DFNARY)&(DFN'=DFNONLY) S DFNFLAG=0
88 ...;======
89 ...;
90 ..S GEC="" F S GEC=$O(^AUPNVHF("AED",DATE,DFN,GEC)) Q:GEC="" D
91 ...Q:GEC'=GECFDA&(GEC'=GEC1DA)&(GEC'=GEC2DA)&(GEC'=GEC3DA)
92 ...S DFNXX=$P($G(^DPT(DFN,0)),"^",1)_" "_$P($G(^DPT(DFN,0)),"^",9)
93 ...S DATEY=$$FMTE^XLFDT(DATE,"1P")
94 ...I $D(^TMP("PXRMGEC",$J,"REF",DATE,DFN)) S ^TMP("PXRMGEC",$J,"REF",DATE,DFN)=$G(^TMP("PXRMGEC",$J,"REF",DATE,DFN))+1
95 ...E S ^TMP("PXRMGEC",$J,"REF",DATE,DFN)=1
96 ...;TO HERE BY REFERRAL
97 ...S DA="" F S DA=$O(^AUPNVHF("AED",DATE,DFN,GEC,DA)) Q:DA="" D
98 ....;TO HERE BY HEALTH FACTOR
99 ....D VDOC(DA)
100 ....D ARAYS
101 D PATIENT^PXRMGECW
102 I ARY="CTD" D DATECNT^PXRMGECW
103 I ARY="CTP" D PATIENT^PXRMGECW
104 I ARY="CTDR" D DOCCNT^PXRMGECW
105 I ARY="CTL" D LOCCNT^PXRMGECW
106 I ARY="LOC" D LOCCNT^PXRMGECW
107 I ARY="DFN" D DOCCNT^PXRMGECW
108 Q
109KILL ;Kill out unwanted Arrays
110 K ^TMP("PXRMGEC",$J,"REF"),^TMP("PXRMGEC",$J,"REFDFN")
111 Q
112VDOC(DA) ;Get Dr's and locationS
113 Q:ARY="CTD"
114 Q:ARY="CTP"
115 ;
116 Q:DA=""
117 Q:'$D(^AUPNVHF(DA))
118 S DOCT=+$P($P($G(^AUPNVHF(DA,801)),"^",2)," ",2)
119 S DOCTN=$$GET1^DIQ(200,DOCT,.01)
120 Q:DOCTN=""
121 S ^TMP("PXRMGEC",$J,"REFDOC",DOCTN,VDT,DOCT)=""
122 ;DBIA #10040 However the ability for the Visit to store a pointer
123 ;to the location file might be removed in the future.
124 S VST=$P($G(^AUPNVHF(DA,0)),"^",3)
125 Q:'$D(^AUPNVSIT(VST))
126 S LOC=$P($G(^AUPNVSIT(VST,0)),"^",22)
127 S LOCN=$P($G(^SC(LOC,0)),"^",1)
128 S ^TMP("PXRMGEC",$J,"REFLOC",LOCN,VDT)=""
129 I ARY="DFN" D
130 .N DSRC,IDENT,DIADA,DIANAME,DATEDA,DATEV
131 .S DSRC=$P($G(^AUPNVHF(DA,812)),"^",3) ;Pointer to data source file
132 .S IDENT=$P($G(^PX(839.7,DSRC,0)),"^",1) ;IDENTIFY Name (GEC1)
133 .Q:'$D(DOCT)
134 .S DIADA=$O(^PXRMD(801.41,"AC",IDENT,0)) ;Dialog ien
135 .S ^TMP("PXRMGEC",$J,"DFN",DOCT,DFN,VDT,DIADA)=""
136 .S ^TMP("PXRMGEC",$J,"DFNCNT",DOCT,DFN,VDT)=""
137 I ARY="LOC" D
138 .;#5 Location Report
139 .S ^TMP("PXRMGEC",$J,"TMPLOC",LOCN,DFNXX,VDT)=""
140 .S ^TMP("PXRMGEC",$J,"LOCB",LOCN,VDT)=""
141 ;
142 Q
143ARAYS ;Set the Arrays for different reports
144 ;===============================================================
145 ;CHeck for new Referral
146 I DATE1'=DATE!(DFN1'=DFN) S CNTREF=CNTREF+1,DATE1=DATE,DFN1=DFN
147 ;===============================================================
148 I ARY="HS" D
149 .;CNTREF=Count or numbered Referral
150 .;DFN =Patient IEN
151 .;DATE =Starting Date of Referral
152 .;VDT =Finished Date of Referral-Visit of GECF
153 .;CAT =Health Factor Category
154 .;DATEV =Date that each Dialog was done
155 .;DA =Ien of each Health Factor
156 .;
157 .N NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA
158 .S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
159 .;GET COMMENTS
160 .S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
161 .S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
162 .S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
163 .Q:DATEV=""
164 .S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
165 .S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
166 .S ^TMP("PXRMGEC",$J,"HS",CNTREF,DFN,DATE,VDT,CAT,DATEV,DA)=""
167 ;===============================================================
168 I ARY="HS1" D
169 .;CNTREF=Count or numbered Referral
170 .;DFN =Patient IEN
171 .;DATE =Starting Date of Referral
172 .;VDT =Finished Date of Referral-Visit of GECF
173 .;CAT =Health Factor Category
174 .;DATEV =Date that each Dialog was done
175 .;DA =Ien of each Health Factor
176 .;DFNXX =Patient's Name
177 .;
178 .N NAMEDA,NAME,CATDA,CAT,DATEV,DATEDA
179 .S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
180 .S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
181 .S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
182 .S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
183 .Q:DATEV=""
184 .S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
185 .S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
186 .S ^TMP("PXRMGEC",$J,"HS1",DFNXX,CNTREF,DATE,VDT,CAT,DATEV,DA)=""
187 .;=============================================================
188 I ARY="HFCD" D
189 .S NAMEDA=$P($G(^AUPNVHF(DA,0)),"^",1)
190 .;GET COMMENTS
191 .S NAME=$P($G(^AUTTHF(NAMEDA,0)),"^",1)
192 .S DATEDA=$P($G(^AUPNVHF(DA,0)),"^",3)
193 .S DATEV=$P($G(^AUPNVSIT(DATEDA,0)),"^",1)
194 .Q:DATEV=""
195 .S CATDA=$P($G(^AUTTHF(NAMEDA,0)),"^",3)
196 .Q:'$D(CATIEN(CATDA))
197 .S CAT=$P($G(^AUTTHF(CATDA,0)),"^",1)
198 .S ^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,NAME,DATEV,DA)=""
199 Q
Note: See TracBrowser for help on using the repository browser.