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

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

initial load of FOIAVistA 6/30/08 version

File size: 7.1 KB
Line 
1DGENCLN1 ;ALB/CJM - National Enrollment Seeding, Patient File Cleanup; 2/22/1999
2 ;;5.3;Registration;**222**;08/13/93
3 ;
4CLEANUP ;This entry point will do the cleanup.
5 ;
6 N DGENSKIP
7 S DGENSKIP=0
8 W !,"*** This is a one-time cleanup for the National Enrollment Seeding ***"
9 W !,"Patient records whose seeding update may not have completed will be"
10 W !,"reported, and a query for each patient will be sent to HEC in order"
11 W !,"to complete the cleanup. Also, records in the Patient file with no"
12 W !,"zero node that were created by the seeding will be deleted."
13 I $$DEVICE() D ENTER
14 Q
15 ;
16REPORT ;This entry point was provided for testing, so that before
17 ;patient records are deleted the site can have a list of
18 ;the DFN's that would be deleted.
19 ;
20 ;Use this entry point to report on what the cleanup would do.
21 ;No changes will be made to the database.
22 ;
23 N DGENSKIP
24 S DGENSKIP=1
25 W !,"*** This is a one-time report for the National Enrollment Seeding ***"
26 W !,"Patient records whose seeding update may not have completed will be"
27 W !,"reported. Also, records in the Patient file with no zero node that"
28 W !,"were created by the seeding will be listed by DFN"
29 I $$DEVICE() D ENTER
30 Q
31 ;
32ENTER ;
33 ;Description: This routine looks at patients included in the
34 ;seeding. It reports each patient where the update may not have
35 ;completed for the fields RECEIVING VA DISABILITY, or ELIGIBLE
36 ;FOR MEDICAID?, or POW STATUS INDICATED? It re-queries HEC for
37 ;those patients.
38 ;
39 N DFN,AUDIT,ANODE,NAME,SSN,COUNT,XREFDFN,NAMESSN,LINE,SEEDDATE,DGENON
40 K ^TMP($J)
41 S (AUDIT,XREFDFN,COUNT)=0
42 ;
43 I '$G(DGENSKIP) D
44 .S DGENON=$$ON^DGENQRY
45 .I 'DGENON D TURNON^DGENQRY
46 F S XREFDFN=$O(^DGENA(27.14,"C",XREFDFN)) Q:'XREFDFN S AUDIT=$O(^DGENA(27.14,"C",XREFDFN,9999999999),-1) Q:'AUDIT D
47 .N COND
48 .S ANODE=$G(^DGENA(27.14,AUDIT,0))
49 .S SEEDDATE=($P(ANODE,"^",2)\1)
50 .S DFN=$P(ANODE,"^",3)
51 .Q:'DFN
52 .Q:(XREFDFN'=DFN)
53 .I $$PARSE(AUDIT,DFN,SEEDDATE,.COND) D
54 ..S COUNT=COUNT+1
55 ..I '$G(DGENSKIP) I $$SEND^DGENQRY1(DFN)
56 ..S NAME=$$NAME^DGENPTA(DFN) Q:(NAME="")
57 ..S SSN=$$SSN^DGENPTA(DFN) Q:(SSN="")
58 ..S NAMESSN=$$LJ(NAME,32)_" "_SSN
59 ..S ^TMP($J,NAMESSN,DFN)=SEEDDATE
60 ..S LINE=0 F S LINE=$O(COND(LINE)) Q:'LINE S ^TMP($J,NAMESSN,DFN,LINE)=COND(LINE)
61 D PRINT(COUNT)
62 K ^TMP($J)
63 I '$G(DGENSKIP) D
64 .I 'DGENON D TURNOFF^DGENQRY
65 ;
66 ;don't need the printer anymore, unless the bad patient records are
67 ;just being reported rather than deleted
68 D:('DGENSKIP) ^%ZISC
69 ;
70 ;process the patient records with no 0 node
71 D DELETE(DGENSKIP)
72 D:(DGENSKIP) ^%ZISC
73 I $D(ZTQUEUED) S ZTREQ="@"
74 Q
75PRINT(COUNT) ;
76 N NAME,DFN,LINE,NODE,PAGE,QUIT,CRT
77 S QUIT=0
78 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
79 U IO
80 W @IOF
81 S PAGE=1
82 D HEADER(1)
83 S NAME=""
84 F S NAME=$O(^TMP($J,NAME)) Q:(NAME="") Q:QUIT D
85 .S DFN=0
86 .F S DFN=$O(^TMP($J,NAME,DFN)) Q:'DFN D
87 ..S LINE=$G(^TMP($J,NAME,DFN))
88 ..S QUIT=$$PLINE(.PAGE,NAME_" "_$$DATE(LINE)) Q:QUIT
89 ..S LINE=0
90 ..F S LINE=$O(^TMP($J,NAME,DFN,LINE)) Q:'LINE S QUIT=$$PLINE(.PAGE," "_$G(^TMP($J,NAME,DFN,LINE))) Q:QUIT
91 ..S QUIT=$$PLINE(.PAGE," ") Q:QUIT
92 W !!," *** Total #Patients Found: "_COUNT_" ***"
93 Q
94 ;
95PARSE(AUDIT,DFN,SEEDDATE,COND) ;
96 ;Description: looks for particular changes in the Enrollment Upload
97 ;Audit file (#27.14) for the record=AUDIT. Returns 1 if found, 0 otherwise.
98 ;
99 N NODE,FOUND,LINE,COUNT,NEWVALUE,PAT,DATABASE
100 S (LINE,FOUND,COUNT)=0
101 F S LINE=$O(^DGENA(27.14,AUDIT,1,LINE)) Q:'LINE D Q:'LINE
102 .S NODE=$G(^DGENA(27.14,AUDIT,1,LINE,0))
103 .;
104 .I NODE["POW:" D
105 ..I '$D(PAT) D GETPAT(DFN,.PAT)
106 ..S NEWVALUE=$$STRIP($E(NODE,41,100))
107 ..S DATABASE=$$EXT^DGENELA3("POW",PAT("POW"))
108 ..I NEWVALUE'=DATABASE S FOUND=1,COUNT=COUNT+1,COND(COUNT)=$$LJ("POW STATUS INDICATED?",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
109 .;
110 .I NODE["MEDICAID:" D
111 ..I '$D(PAT) D GETPAT(DFN,.PAT)
112 ..S NEWVALUE=$$STRIP($E(NODE,41,100))
113 ..S DATABASE=$$EXT^DGENELA3("MEDICAID",PAT("MEDICAID"))
114 ..I NEWVALUE'=DATABASE,(SEEDDATE>PAT("LAST ASKED")) S FOUND=1,COUNT=COUNT+1,COND(COUNT)=$$LJ("ELIGIBLE FOR MEDICAID? ",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
115 .;
116 .I NODE["VADISAB:" D
117 ..I '$D(PAT) D GETPAT(DFN,.PAT)
118 ..S DATABASE=$$EXT^DGENELA3("VADISAB",PAT("VADISAB"))
119 ..S NEWVALUE=$$STRIP($E(NODE,41,100))
120 ..I NEWVALUE'=DATABASE S FOUND=1,COUNT=COUNT+1,COND(COUNT)=$$LJ("RECEIVING VA DISABILITY?",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
121 Q FOUND
122 ;
123GETPAT(DFN,PAT) ;
124 ;Gets several fields from the patient file and returns them in the PAT
125 ;array
126 ;
127 N NODE
128 S PAT("VADISAB")=$P($G(^DPT(DFN,.3)),"^",11)
129 S PAT("POW")=$P($G(^DPT(DFN,.52)),"^",5)
130 S NODE=$G(^DPT(DFN,.38))
131 S PAT("MEDICAID")=$P(NODE,"^")
132 S PAT("LAST ASKED")=$P(NODE,"^",2)
133 Q
134DEVICE() ;
135 ;Description: allows the user to select a device.
136 ;
137 ;Output:
138 ; Function Value - Returns 0 if the user decides not to print or to
139 ; queue the report, 1 otherwise.
140 ;
141 N OK
142 S OK=1
143 S %ZIS="MQ"
144 D ^%ZIS
145 S:POP OK=0
146 D:OK&$D(IO("Q"))
147 .S ZTRTN="ENTER^DGENCLN1",ZTDESC=$S(DGENSKIP:"Report",1:"Cleanup")_" of Incomplete Patient Updates, Enrollment Seeding"
148 .S ZTSAVE("DGENSKIP")=""
149 .D ^%ZTLOAD
150 .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
151 .D HOME^%ZIS
152 .S OK=0
153 Q OK
154 ;
155PLINE(PAGE,LINE) ;
156 ;Description: prints a line. First prints header if at end of page.
157 ;Returns 1 on success, 0 if the user enters '^'
158 ;
159 N QUIT S QUIT=0
160 I CRT,($Y>(IOSL-5)) D
161 .S QUIT=$$PAUSE
162 .Q:QUIT
163 .W @IOF
164 .S PAGE=PAGE+1
165 .D HEADER(PAGE)
166 .W LINE
167 ;
168 E I ('CRT),($Y>(IOSL-5)) D
169 .W @IOF
170 .S PAGE=PAGE+1
171 .D HEADER(PAGE)
172 .W LINE
173 ;
174 E W !,LINE
175 Q QUIT
176 ;
177HEADER(PAGE) ;
178 W !,?((IOM-77)/2),"Incomplete Patient Updates from National Enrollment Seeding",?(IOM-10),"PAGE: ",PAGE
179 W !,?((IOM-24)\2),$$FMTE^XLFDT(DT,"D")
180 W !!," Patient SSN Date Of Seeding"
181 W !,"____________________________________________________________________________",!
182 Q
183 ;
184PAUSE() ;
185 ;Description: Screen pause. Sets QUIT=1 if user decides to quit.
186 ;
187 N DIR,X,Y,QUIT
188 S QUIT=0
189 F Q:$Y>(IOSL-4) W !
190 S DIR(0)="E" D ^DIR
191 I '(+Y) S QUIT=1
192 Q QUIT
193 ;
194DATE(FMDATE) ;
195 N DATE S DATE=""
196 S FMDATE=FMDATE\1
197 I FMDATE S DATE=$$FMTE^XLFDT(FMDATE,"1")
198 Q DATE
199 ;
200 ;
201LJ(STR,LEN) ;
202 Q $$LJ^XLFSTR($E(STR,1,LEN),LEN)
203 ;
204STRIP(STR) ;
205 N I
206 F I=1:1:$L(STR) I $E(STR,I,I)'=" " Q
207 S STR=$E(STR,I,$L(STR))
208 S STR=$REVERSE(STR)
209 F I=1:1:$L(STR) I $E(STR,I,I)'=" " Q
210 S STR=$E(STR,I,$L(STR))
211 S STR=$REVERSE(STR)
212 Q STR
213 ;
214DELETE(DGENSKIP) ;
215 ;This will delete bogus patient records created during the seeding
216 ;A patient record will be deleted if the only nodes are the .3,
217 ;.38, or .52
218 ;
219 ;Input: DGENSKIP - if =1, the the records will not be deleted, but just reported
220 ;
221 N DFN,SUB,GOOD,COUNT
222 W:DGENSKIP !!!,"Begining to search for bad patient records...."
223 S (COUNT,DFN)=0
224 F S DFN=$O(^DPT(DFN)) Q:'DFN D
225 .S SUB=""
226 .S GOOD=0
227 .F S SUB=$O(^DPT(DFN,SUB)) Q:(SUB="") D
228 ..I (SUB'=.3),(SUB'=.38),(SUB'=.52) S GOOD=1 Q
229 .I 'GOOD D
230 ..S COUNT=COUNT+1
231 ..I DGENSKIP W !,"BAD PATIENT RECORD FOUND, DFN= ",DFN
232 ..I 'DGENSKIP D
233 ...N DIK,DA
234 ...S DIK="^DPT(",DA=DFN D ^DIK
235 W:DGENSKIP !!,"*** COUNT OF BAD PATIENT RECORDS (MISSING THE 0 NODE)"_$S(DGENSKIP:"",1:" DELETED")_": ",COUNT," ***"
236 Q
Note: See TracBrowser for help on using the repository browser.