source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGREGARP.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1DGREGARP ;ALB/DW-Address audit reports; 6/2/2003
2 ;;5.3;Registration;**522,560**;Aug 13, 1993
3EN(TYPE) ;Entry point
4 N DGRNG,XMY,XMSUB,XMDUZ,XMTEXT,DGSRT,DGTOTAL
5 K ^TMP($J,"DG ADD CHNG RPRT")
6 K ^TMP($J,"DG ADDRESS BEFORE")
7 I ($G(TYPE)'="ALL")&($G(TYPE)'="RX") Q
8 ;If mail group has no member or remote-member
9 I '$$MEMBER() D Q
10 . I '$D(ZTQUEUED) W !!,"DG DAILY ADDRESS CHANGE does not have a member. Report not sent." D EOP^DGREGAED
11 ;Entry from TaskMan
12 I $D(ZTQUEUED) D Q
13 . D PRINT
14 ;User runs the option
15 I '$D(ZTQUEUED) D
16 . W !!,"The report will be sent to mail group DG DAILY ADDRESS CHANGE."
17 . D QUE
18 . W !! D EOP^DGREGAED
19 Q
20MEMBER() ;Return 0 if mail group has no local or remote member
21 N RESULT,DGIEN,DGRMT
22 S RESULT=1
23 S DGIEN=$$FIND1^DIC(3.8,"","X","DG DAILY ADDRESS CHANGE")
24 D LIST^DIC(3.812,","_DGIEN_",",.01,"P","","","","","","","DGRMT")
25 I ($P($G(DGRMT("DILIST",0)),U)'>0),('$$GOTLOCAL^XMXAPIG("DG DAILY ADDRESS CHANGE")) S RESULT=0
26 Q RESULT
27QUE ;Que the task if user invokes option
28 N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
29 W !
30 S ZTIO=""
31 S ZTSAVE("TYPE")=""
32 S ZTRTN="PRINT^DGREGARP"
33 S ZTDESC="DG "_$G(TYPE)_" ADDRESS CHANGE REPORT"
34 D ^%ZTLOAD
35 D ^%ZISC,HOME^%ZIS
36 W !,$S($D(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
37 Q
38PRESORT ;Sort for the report
39 N DGRNG
40 D RANGE(.DGRNG)
41 I DGRNG=-1 Q
42 D SORT(.DGRNG,TYPE)
43 Q
44PRINT ;Create the email message.
45 N DGLINE,DFN,SSN,IEN
46 S (DGLINE,DFN,SSN,IEN)=0
47 D CHKPAR
48 D HEADER
49 D PRESORT
50 D REPORT
51 D TOTAL
52 D EMAIL(TYPE)
53 Q
54 ;
55REPORT ;Create the address change report body
56 N DGNAME,DGSSN,DGDFN
57 N DGR,DGUSER,DGDATE,DGSRC,DG12
58 N DGOADD1,DGOADD2,DGOADD3,DGOCITY,DGOST,DGOZIP,DGOCNTY
59 N DGNADD1,DGNADD2,DGNADD3,DGNCITY,DGNST,DGNZIP,DGNCNTY,DGOPHN,DGHPHN
60 N DGPRSCRP
61 S (DGNAME,DGSSN,DGDFN)=""
62 F S DGNAME=$O(^TMP($J,"DG ADDRESS BEFORE",DGNAME)) Q:DGNAME="" D
63 . S DGSSN=""
64 . F S DGSSN=$O(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN)) Q:DGSSN="" D
65 .. S DGDFN=""
66 .. F S DGDFN=$O(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN)) Q:DGDFN="" D
67 ... D GEN(DGNAME,DGSSN,DGDFN)
68 ... D OLD(DGNAME,DGSSN,DGDFN)
69 ... D NEW(DGNAME,DGSSN,DGDFN)
70 ... D PRSCPT(DGDFN)
71 Q
72GEN(DGNAME,DGSSN,DGDFN) ;General information for each patient
73 K DGR
74 D GETS^DIQ(2,DGDFN_",",".122;.118;.119;.12","E","DGR")
75 S DGUSER=$G(DGR(2,DGDFN_",",.122,"E"))
76 S DGDATE=$G(DGR(2,DGDFN_",",.118,"E"))
77 S DGSRC=$G(DGR(2,DGDFN_",",.119,"E"))
78 S DG12=$G(DGR(2,DGDFN_",",.12,"E"))
79 D
80 . D LNPLUS
81 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=""
82 . D LNPLUS
83 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" PATIENT: "_DGNAME_" SSN: "_$E(DGSSN,6,10)
84 . D LNPLUS
85 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" USER: "_DGUSER_" DATE: "_DGDATE
86 . D LNPLUS
87 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" SOURCE: "_DGSRC_" "_DG12
88 Q
89OLD(DGNAME,DGSSN,DGDFN) ;Get address as of 24 hours ago, assuming audits are on for all
90 S DGOADD1=$G(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,.111))
91 S DGOADD2=$G(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,.112))
92 S DGOADD3=$G(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,.113))
93 S DGOCITY=$G(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,.114))
94 S DGOST=$G(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,.115))
95 S DGOZIP=$G(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,.1112))
96 S DGOCNTY=$G(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,.117))
97 D
98 . D LNPLUS
99 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" BEFORE: "_DGOADD1
100 . I $G(DGOADD2)'="" D
101 .. D LNPLUS
102 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_DGOADD2
103 . I $G(DGOADD3)'="" D
104 .. D LNPLUS
105 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_DGOADD3
106 . I (DGOCITY'="")!(DGOST'="") D
107 .. D LNPLUS
108 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_DGOCITY_","_DGOST_" "_DGOZIP
109 . I (DGOCNTY'="") D
110 .. D LNPLUS
111 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_"COUNTY CODE: "_DGOCNTY
112 Q
113NEW(DGNAME,DGSSN,DGDFN) ;Get current address
114 K DGCURR
115 D GETS^DIQ(2,DGDFN_",",".111;.112;.113;.114;.115;.116;.117;.119;.12;.1112;.131;.132","E","DGCURR")
116 S DGNADD1=$G(DGCURR(2,DGDFN_",",.111,"E"))
117 S DGNADD2=$G(DGCURR(2,DGDFN_",",.112,"E"))
118 S DGNADD3=$G(DGCURR(2,DGDFN_",",.113,"E"))
119 S DGNCITY=$G(DGCURR(2,DGDFN_",",.114,"E"))
120 S DGNST=$G(DGCURR(2,DGDFN_",",.115,"E"))
121 S DGNZIP=$G(DGCURR(2,DGDFN_",",.1112,"E"))
122 S DGNCNTY=$G(DGCURR(2,DGDFN_",",.117,"E"))
123 S DGOPHN=$G(DGCURR(2,DGDFN_",",.132,"E"))
124 S DGHPHN=$G(DGCURR(2,DGDFN_",",.131,"E"))
125 D
126 . D LNPLUS
127 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" AFTER: "_DGNADD1
128 . I $G(DGNADD2)'="" D
129 .. D LNPLUS
130 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_DGNADD2
131 . I $G(DGNADD3)'="" D
132 .. D LNPLUS
133 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_DGNADD3
134 . I (DGNCITY'="")!(DGNST'="") D
135 .. D LNPLUS
136 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_DGNCITY_","_DGNST_" "_DGNZIP
137 . I (DGNCNTY'="") D
138 .. D LNPLUS
139 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_"COUNTY CODE: "_DGNCNTY
140 . D LNPLUS
141 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_"PHONE(H): "_DGHPHN
142 . D LNPLUS
143 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" "_"PHONE(O): "_DGOPHN
144 Q
145PRSCPT(DGDFN) ;Display if the patient has active prescription
146 S DGPRSCRP=$$EN^PSSRXACT(DGDFN)
147 I $G(DGPRSCRP)=1 D
148 . D LNPLUS
149 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)="Patient has active pharmacy prescription(s)"
150 Q
151EXIT S:$D(ZTQUEUED) ZTREQ="@"
152 K ^TMP($J,"DG ADD CHNG RPRT")
153 K ^TMP($J,"DG ADDRESS BEFORE")
154 Q
155CHKPAR ;Check if audit is on for the fields
156 N DGR,DGN,DGFLD
157 F DGN=.111,.112,.113,.114,.115,.116,.117,.1112 D
158 . K DGR
159 . D FIELD^DID(2,DGN,"","LABEL;AUDIT","DGR")
160 . I $D(DGR("DIERR")) Q
161 . I ($G(DGR("AUDIT"))'["YES")&($G(DGR("AUDIT"))'["EDITED OR DELETED") D
162 .. D LNPLUS^DGREGARP
163 .. S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)="Audit is off for the "_$G(DGR("LABEL"))_" field"
164 Q
165RANGE(RESULT) ;Get the range of the reports
166 K RESULT
167 N DGBEGIN,DGEND,DGNOW,DGAGO
168 N X,X1,X2
169 D NOW^%DTC
170 S DGNOW=%
171 S X1=%,X2="-1" D C^%DTC
172 S DGAGO=X
173 S DGNOW=$O(^DIA(2,"C",DGNOW),-1)
174 S DGAGO=$O(^DIA(2,"C",DGAGO))
175 I ($G(DGNOW)="")!($G(DGAGO)="") S RESULT=-1 Q
176 S (DGBEGIN,DGEND)=""
177 S DGBEGIN=$O(^DIA(2,"C",DGNOW,DGBEGIN),-1)
178 S DGEND=$O(^DIA(2,"C",DGAGO,DGEND))
179 I $G(DGBEGIN)=""!$G(DGEND)="" S RESULT=-1 Q
180 S DGBEGIN=DGBEGIN+1
181 S RESULT=DGBEGIN_U_DGEND
182 Q
183SORT(RANGE,TYPE) ;Build the temp global to display
184 N DGBEGIN,DGEND,DGIEN,DGDFN,DGFLD
185 S DGIEN=$P($G(RANGE),U)
186 S DGEND=$P($G(RANGE),U,2)
187 F S DGIEN=$O(^DIA(2,DGIEN),-1) Q:DGIEN<DGEND D:$$SCRN(TYPE,DGIEN)
188 . D BUILD(TYPE,DGIEN)
189 Q
190SCRN(TYPE,DGIEN) ;Screen Audit file to find address changes.
191 N DGFLD
192 S DGFLD=$P($G(^DIA(2,DGIEN,0)),U,3)
193 I (DGFLD=.114)!(DGFLD=.116)!(DGFLD=.117)!(DGFLD=.1112)!(DGFLD=.115) Q 1
194 I (DGFLD=.111)!(DGFLD=.112)!(DGFLD=.113) Q 1
195 Q 0
196BUILD(TYPE,DGIEN) ;Build temp global
197 N DGDFN,DGFLD,DGNAME,DGSSN,DGCURR,DGN
198 S DGDFN=$P($G(^DIA(2,DGIEN,0)),U)
199 I $G(TYPE)="RX" Q:'$$EN^PSSRXACT(DGDFN)
200 D GETS^DIQ(2,DGDFN_",",".01;.09","E","DGCURR")
201 S DGNAME=$G(DGCURR(2,DGDFN_",",.01,"E"))
202 S DGSSN=$G(DGCURR(2,DGDFN_",",.09,"E"))
203 I ($G(DGNAME)="")!($G(DGSSN)="")!($G(DGDFN)="") Q
204 S DGFLD=$P($G(^DIA(2,DGIEN,0)),U,3)
205 I '$D(^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN)) D
206 . ;Get current address
207 . K DGCURR,DGN
208 . D GETS^DIQ(2,DGDFN_",",".111;.112;.113;.114;.115;.116;.117;.1112","E","DGCURR")
209 . F DGN=.111,.112,.113,.114,.115,.116,.117,.1112 D
210 .. S ^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,DGN)=$G(DGCURR(2,DGDFN_",",DGN,"E"))
211 . S DGTOTAL=$G(DGTOTAL)+1
212 S ^TMP($J,"DG ADDRESS BEFORE",DGNAME,DGSSN,DGDFN,DGFLD)=$P($G(^DIA(2,DGIEN,2)),U)
213 Q
214LNPLUS ;Increase line number for the email text
215 S DGLINE=$G(DGLINE)+1
216 Q
217HEADER ;Report header
218 N RDT,Y
219 I $G(TYPE)="ALL" D
220 . D LNPLUS
221 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=""
222 . D LNPLUS
223 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" ALL ADDRESS CHANGE REPORT"
224 I $G(TYPE)="RX" D
225 . D LNPLUS
226 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=""
227 . D LNPLUS
228 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" ALL ADDRESS CHANGE FOR PATIENTS WITH ACTIVE PRESCRIPTIONS REPORT"
229 D NOW^%DTC S Y=% X ^DD("DD")
230 S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)
231 D
232 . D LNPLUS
233 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" The BEFORE address shown may not be accurate."
234 . D LNPLUS
235 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" It is only valid as of 24 hours prior to running the report."
236 . D LNPLUS
237 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" Changes within the last 24 hours will not be shown."
238 . D LNPLUS^DGREGARP
239 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=" Date/Time Report Run: "_RDT
240 . D LNPLUS^DGREGARP
241 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)="-----------------------------------------------------------------------------"
242 Q
243TOTAL ;Get the total of the patients
244 N DGCNT
245 ;S DGCNT=$G(^TMP($J,"DG ADDRESS BEFORE","TOTAL"))
246 S DGCNT=$G(DGTOTAL)
247 I $G(DGCNT)>0 D
248 . D LNPLUS
249 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)=""
250 . D LNPLUS
251 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)="TOTAL RECORD(S): "_DGCNT
252 Q
253EMAIL(TYPE) ;Email the report to mailgroup.
254 ;If called within a task, protect variables
255 I $D(ZTQUEUED) N %,DIFROM
256 N RDT
257 D NOW^%DTC S Y=% X ^DD("DD")
258 S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)
259 S XMSUB="DG "_$G(TYPE)_" ADDRESS CHANGE ("_RDT_")"
260 S XMY("G.DG DAILY ADDRESS CHANGE")=""
261 I $G(DGTOTAL)'>0 D
262 . D LNPLUS
263 . S ^TMP($J,"DG ADD CHNG RPRT",DGLINE)="*** NO RECORDS TO PRINT ***"
264 S XMTEXT="^TMP($J,""DG ADD CHNG RPRT"","
265 D ^XMD
266 Q
Note: See TracBrowser for help on using the repository browser.