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

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

initial load of FOIAVistA 6/30/08 version

File size: 6.7 KB
Line 
1DG53467P ; ALB/SCK - POST INSTALLATION ROUTINE DG*5.3*467 ; 8/6/2002
2 ;;5.3;Registration;**467**;Aug 13, 1993
3 ;
4EN ; Main entry point for means test cleanup
5 ;
6 I '$D(^XUSEC("DG MTDELETE",+DUZ)) W !!,">>> You must have the Means Test Delete key to run this cleanup!",$CHAR(7) Q
7 ;
8 ;; Check for XTMP global
9 I $D(^XTMP("DG467",0)) D
10 . Q:'$$CHECK
11 . D CLNUP
12 . I '$D(^XTMP("DG467")) D
13 . . W !!?3,"Cleanup complete, the ^XTMP global has been removed."
14 E D QUE
15 ;
16 Q
17 ;
18QUE ; Que off a task to search for means test records with a missing status
19 N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO
20 ;
21 W @IOF
22 W !!?3,"This will task off the search for Means Test records with a missing means"
23 W !?3,"test status. Re-running this entry point after completion of the search"
24 W !?3,"will initiate the cleanup process of these means test records."
25 ;
26 S ZTRTN="BUILD^DG53467P"
27 S ZTDESC="SEARCH FOR MEANS TEST RECORDS WITH MISSING STATUS"
28 S ZTDTH="NOW"
29 S ZTIO=""
30 D ^%ZTLOAD
31 ;
32 I $D(ZTSK)[0 W !!?5,"Search canceled!"
33 E W !!?5,"Search queued! [ ",ZTSK," ]"
34 D HOME^%ZIS
35 Q
36 ;
37BUILD ; Build list of means test records and store in temporary global
38 N MTIEN,MTNDE,ZNODE
39 ;
40 S ^XTMP("DG467",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^MEANS TEST CLEANUP, PATCH DG*5.3*467"
41 ;
42 S MTIEN=0
43 F S MTIEN=$O(^DGMT(408.31,MTIEN)) Q:'MTIEN D
44 . S MTNDE=$G(^DGMT(408.31,MTIEN,0))
45 . Q:$P(MTNDE,U,3)]"" ;; Null MT Status
46 . Q:$P(MTNDE,U,19)'=1 ;; Type of Test (MT = 1)
47 . S ^XTMP("DG467",1,MTIEN)=MTNDE
48 S ^XTMP("DG467",0,"END")=$H
49 Q
50 ;
51CHECK() ; Check for an existing XTMP global from a previous search. If one is found,
52 ; continue processing means test records for deletion.
53 N DIR,RSLT,LASTDT,CNT,NDX,RTN,Y
54 ;
55 I '$D(^XTMP("DG467",0,"END")) D Q 0
56 . W !!?3,">> The means test search for records with a missing status is still in"
57 . W !?3,">> progress. Please check back later."
58 ;
59 I '$D(^XTMP("DG467",1)) D Q 0
60 . W !?3,">> The cleanup search was completed on "_$$FMTE^XLFDT($P(^XTMP("DG467",0),U,2))
61 . W !?3," There were no means test records found."
62 . S DIR(0)="YAO",DIR("B")="NO",DIR("A")="Do you wish to re-run the search? "
63 . D ^DIR K DIR
64 . I +Y K ^XTMP("DG467") D QUE
65 ;
66 S LASTDT=$P(^XTMP("DG467",0),U,2)
67 S (CNT,NDX)=0
68 F S NDX=$O(^XTMP("DG467",1,NDX)) Q:'NDX S CNT=CNT+1
69 ;
70 S DIR(0)="YAO",DIR("B")="YES"
71 S DIR("A",1)=CNT_" Means Test records with a missing means test status from a"
72 S DIR("A",2)="search on "_$S(LASTDT>0:$$FMTE^XLFDT(LASTDT),1:"")_" are available for processing."
73 S DIR("A")="Continue processing? "
74 S DIR("?")="HELP"
75 D ^DIR K DIR
76 I $D(DIRUT)!'Y Q 0
77 Q 1
78 ;
79CLNUP ; Process XTMP global means test records for deletion
80 N DIR,NDX,DIRUT,RSLT,Y
81 ;
82 K ^TMP("DG467",$J)
83 ;
84 S DIR(0)="YAO",DIR("B")="NO",DIR("A",1)=""
85 S DIR("A")="Do you wish to print out a list of the means test records? "
86 D ^DIR K DIR
87 I Y D PRINT
88 ;
89 S DIR(0)="FAO",DIR("A")="Press any key to continue..."
90 D ^DIR K DIR
91 ;
92 W @IOF
93 ;; Begin loop through XTMP global
94 S NDX=0
95 F S NDX=$O(^XTMP("DG467",1,NDX)) Q:'NDX D Q:$D(DIRUT)
96 . D DISPLY(^XTMP("DG467",1,NDX),NDX)
97 . S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Delete this means test record? "
98 . D ^DIR K DIR
99 . Q:$D(DIRUT)!('Y)
100 . S:$D(^DGMT(408.31,NDX,0)) ^TMP("DG467",$J,NDX,0)=^DGMT(408.31,NDX,0)
101 . S:$D(^DGMT(408.31,NDX,2)) ^TMP("DG467",$J,NDX,2)=^DGMT(408.31,NDX,2)
102 . S:$D(^DGMT(408.31,NDX,"PRIM")) ^TMP("DG467",$J,NDX,"PRIM")=^DGMT(408.31,NDX,"PRIM")
103 . S RSLT=$$EN^IVMCMD(NDX)
104 . I RSLT W !?5,">>> DELETED"
105 . E D
106 . . W !?5,"The deletion call was unable to remove record ",NDX
107 . . S DIR(0)="FAO",DIR("A")="Press any key to continue..."
108 . . D ^DIR K DIR
109 . . K ^TMP("DG467",$J,NDX)
110 . K ^XTMP("DG467",1,NDX)
111 ;
112 D NOTIFY
113 ;
114 I '$D(^XTMP("DG467",1)) D
115 . K ^XTMP("DG467")
116 Q
117 ;
118PRINT ; Print a report of the means test records found without a status
119 N DIR,ZTSAVE
120 ;
121 W !!,"Report requires 132-col printer."
122 S ZTSAVE("DUZ")=""
123 D EN^XUTMDEVQ("REPORT^DG53467P","Missing Means Test Status Cleanup report",.ZTSAVE)
124 ;
125 D HOME^%ZIS
126 Q
127 ;
128DISPLY(NODE0,MTIEN) ; Display the means test record being processed for deletion
129 N DFN,VA
130 ;
131 W @IOF
132 S DFN=+$P(NODE0,U,2) D PID^VADPT6
133 W !?3,"Name : ",$$GET1^DIQ(2,DFN,.01)
134 W !?3,"SSN : ",VA("PID")
135 W !?3,"Date of Test : ",$$FMTE^XLFDT($P(NODE0,U,1))
136 W !?3,"Status : "
137 I +$P(NODE0,U,3)>0 W $$GET1^DIQ(408.32,$P(NODE0,U,3),.01)
138 W !?3,"Completed By : "
139 I +$P(NODE0,U,6)>0 W $$GET1^DIQ(2,$P(NODE0,U,6),.01)
140 W !?3,"Prim Inc Test for Yr : ",$$GET1^DIQ(408.31,NDX,2)
141 W !?3,"Test Determined Status : ",$$GET1^DIQ(408.32,+$$GET1^DIQ(408.31,NDX,2.03),.01)
142 W !?3,"Source of Income Test : "
143 I +$P(NODE0,U,23)>0 W $$GET1^DIQ(408.34,$P(NODE0,U,23),.01)
144 W !
145 Q
146 ;
147REPORT ; Print report of found MT records stored in the XTMP global
148 N PAGE,NDX,NODE,DFN,VA
149 ;
150 S PAGE=1
151 D HDR
152 S NDX=0
153 F S NDX=$O(^XTMP("DG467",1,NDX)) Q:'NDX D
154 . S NODE=^XTMP("DG467",1,NDX)
155 . S DFN=+$P(NODE,U,2) D PID^VADPT6
156 . W !,$$GET1^DIQ(2,DFN,.01)
157 . W ?30,VA("BID")
158 . W ?40,$$FMTE^XLFDT($P(NODE,U,1))
159 . I +$P(NODE,U,6)>0 W ?56,$$GET1^DIQ(2,$P(NODE,U,6),.01)
160 . W ?85,$$GET1^DIQ(408.31,NDX,2)
161 . W ?98,$$GET1^DIQ(408.32,+$$GET1^DIQ(408.31,NDX,2.03),.01)
162 Q
163 ;
164HDR ; Print Report header
165 N DDASH
166 ;
167 W "Report of Means Test Records with Missing Status not yet Processed"
168 W !,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
169 W !,"Page ",PAGE
170 W !!?85,"Principle"
171 W !?30,"Last",?40,"Date",?85,"Inc. Test",?98,"Test-Determined"
172 W !,"Name",?30,"Four",?40,"of Test",?56,"Completed by",?85,"for Year",?98,"Status"
173 S $P(DDASH,"=",IOM)="" W !,DDASH
174 Q
175 ;
176NOTIFY ; Send notification message when clenup session is completed
177 N FNAME,PATH,XMSUB,XMTEXT,MSG,XMDUZ,NDX,POP,XMY,X,IO
178 ;
179 ;; Store off a copy of the MT records deleted this session
180 S X=$$NOW^XLFDT,FNAME=$P(X,".",1)_"_"_$P(X,".",2)_".TXT"
181 S PATH=$$PWD^%ZISH
182 ;
183 D OPEN^%ZISH("FILE1",PATH,FNAME,"A")
184 I 'POP D
185 . U IO
186 . S NDX=0
187 . F S NDX=$O(^TMP("DG467",$J,NDX)) Q:'NDX D
188 . . W NDX_" | (0) "_$G(^TMP("DG467",$J,NDX,0)),!
189 . . W NDX_" | (2) "_$G(^TMP("DG467",$J,NDX,2)),!
190 . . W NDX_" | (PRIM) "_$G(^TMP("DG467",$J,NDX,"PRIM")),!
191 . D CLOSE^%ZISH("FILE1")
192 ;
193 S MSG(1)="A partial copy of the Means Test records deleted through the"
194 S MSG(2)="Patch DG*5.3*467 cleanup session of "_$$FMTE^XLFDT($$NOW^XLFDT)
195 S MSG(3)="have been saved to the following file:"
196 S MSG(3.5)=""
197 S MSG(4)="Filename: "_FNAME
198 S MSG(5)=" Path: "_PATH
199 ;
200 S XMSUB="Means Test Cleanup Results"
201 S XMY(DUZ)=""
202 S XMDUZ="DG53_467 MT Cleanup"
203 S XMTEXT="MSG("
204 D ^XMD
205 Q
206 ;
207QUERY ; Report query
208 N L,DIC,FLDS,BY,FR,TO,PG,DHD
209 ;
210 S L=0
211 S DIC="^DGMT(408.31,"
212 S FLDS="NUMBER,.02,.01"
213 S BY=".03,.019,.23"
214 S FR="@,MEANS TEST,OTHER FACILITY"
215 S TO="@,MEANS TEST,OTHER FACILITY"
216 S PG=1
217 S DHD="Patients Missing a Means Test Status"
218 ;
219 D EN1^DIP
220 Q
Note: See TracBrowser for help on using the repository browser.