source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53514.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: 6.8 KB
Line 
1DG53514 ;ALB/PHH - DG*5.3*514 DOD Cleanup ; 4/25/03
2 ;;5.3;Registration;**514**;Aug 13, 1993
3 Q
4RESET ; Reset the data for the cleanup process
5 K ^XTMP($$NAMESPC)
6 Q
7TEST ; Simulate Live Run
8 N MODE
9 S MODE=0
10START ; Start Processor
11 N NAMESPC,QTIME
12 S NAMESPC=$$NAMESPC
13 Q:$$RUNCHK(NAMESPC) ; Quit if already running or has run to completion
14 Q:$$QTIME(.QTIME)
15 S:$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) MODE=^XTMP(NAMESPC,"CONFIG","RUN MODE")
16 S:'$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) ^XTMP(NAMESPC,"CONFIG","RUN MODE")=$S($G(MODE)=0:0,1:1)
17 S ^XTMP(NAMESPC,"CONFIG","USER")=$S($G(DUZ)'="":DUZ,1:"UNKNOWN")
18 S:'$$QUEUE(QTIME) ^XTMP(NAMESPC,"CONFIG","RUNNING")=""
19 Q
20NAMESPC() ; API returns the name space for this patch
21 Q "DG514"
22RUNCHK(NAMESPC) ; Check to see if clean up is already running
23 Q:NAMESPC="" 1 ; Name Space must be defined
24 Q:$D(^XTMP(NAMESPC,"CONFIG","RUNNING")) 1
25 Q:$D(^XTMP(NAMESPC,"CONFIG","COMPLETE")) 1
26 Q 0
27QTIME(WHEN) ; Get the run time for queuing
28 N %,%H,%I,X
29 D NOW^%DTC
30 S WHEN=$P(%,".")_"."_$E($P(%,".",2),1,4)
31 Q 0
32QUEUE(ZTDTH) ; Queue the process
33 N NAMESPC,QUEERR,ZTDESC,ZTRTN,ZTSK
34 S NAMESPC=$$NAMESPC
35 S QUEERR=0
36 S ZTRTN="CLEAN^DG53"_$P(NAMESPC,"DG",2)
37 S ZTDESC=NAMESPC_" - DOD Cleanup Process"
38 S ZTIO=""
39 D ^%ZTLOAD
40 K ^XTMP(NAMESPC,"CONFIG","ZTSK")
41 I '$D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Unable to queue post-install process.",QUEERR=1
42 I $D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Post-install queued. Task ID: "_$G(ZTSK)
43 D HOME^%ZIS
44 Q QUEERR
45CLEAN ; Actual cleanup process
46 N NAMESPC,MODE,USER,TASKID,%,%H,%I,X,X1,X2,CHKCNT,TMSWT,TOTDPT,DFN
47 S NAMESPC=$$NAMESPC
48 K ^XTMP(NAMESPC,"CONFIG","ABORT TIME")
49 S MODE=$G(^XTMP(NAMESPC,"CONFIG","RUN MODE"),0)
50 S USER=$G(^XTMP(NAMESPC,"CONFIG","USER"),"UNKNOWN")
51 S TASKID=$G(^XTMP(NAMESPC,"CONFIG","ZTSK"),"UNKNOWN")
52 ;
53 I '$D(^XTMP(NAMESPC,0)) D
54 .K ^XTMP(NAMESPC)
55 .S ^XTMP(NAMESPC,"CONFIG","DFN")=0
56 .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=0
57 .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=0
58 .S ^XTMP(NAMESPC,"CONFIG","RUN MODE")=MODE
59 .S ^XTMP(NAMESPC,"CONFIG","USER")=USER
60 .S ^XTMP(NAMESPC,"CONFIG","ZTSK")=TASKID
61 .D NOW^%DTC
62 .S ^XTMP(NAMESPC,"CONFIG","START TIME")=%
63 .S X1=$$DT^XLFDT,X2=90
64 .D C^%DTC
65 .S ^XTMP(NAMESPC,0)=X_U_$$DT^XLFDT_U_NAMESPC_" - DOD CLEANUP"
66 ;
67 S CHKCNT=250,(ZTSTOP,TMSWT)=0,TOTDPT=+$P($G(^DPT(0)),"^",4)
68 S DFN=$G(^XTMP(NAMESPC,"CONFIG","DFN"))
69 F S DFN=$O(^DPT(DFN)) Q:'DFN!(TMSWT) D
70 .D PROC(DFN)
71 .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))+1
72 .S ^XTMP(NAMESPC,"CONFIG","DFN")=DFN
73 .I TOTDPT D
74 ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))/TOTDPT
75 ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$P((^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")*100),".")
76 .I +$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))#CHKCNT=0 D
77 ..S TMSWT=$$STOPIT()
78 ..I TMSWT D
79 ...S ZTSTOP=1
80 ...N %,%H,%I,X
81 ...D NOW^%DTC
82 ...S ^XTMP(NAMESPC,"CONFIG","ABORT TIME")=%
83 ...D ABORTMSG
84 ;
85 I 'DFN,'TMSWT D
86 .N %,%H,%I,X
87 .D NOW^%DTC
88 .S ^XTMP(NAMESPC,"CONFIG","COMPLETE")=%
89 .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=100
90 .D DONEMSG
91 ;
92 K ^XTMP(NAMESPC,"CONFIG","RUNNING")
93 Q
94PROC(DFN) ; Process the DFN
95 N NAMESPC,DOD,CURENR,ENRSTAT,QLOGIEN,SUCCESS
96 S NAMESPC=$$NAMESPC
97 S DOD=$P($G(^DPT(DFN,.35)),"^")
98 Q:DOD=""
99 S CURENR=$P($G(^DPT(DFN,"ENR")),"^") ; Get Current Enr Record
100 Q:CURENR=""
101 S ENRSTAT=$P($G(^DGEN(27.11,CURENR,0)),"^",4)
102 Q:ENRSTAT'=1 ; Quit if it's not an 'Unverified' status
103 ;
104 S ^XTMP(NAMESPC,"DATA",DFN)=""
105 S ^XTMP(NAMESPC,"CONFIG","ANOMALY")=$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))+1
106 S ^XTMP(NAMESPC,"CONFIG","DFN")=DFN
107 ;
108 S SUCCESS=0
109 I MODE S SUCCESS=$$SEND(DFN) ; Resend the Z11 query
110 S $P(^XTMP(NAMESPC,"DATA",DFN),"^")=SUCCESS
111 ;
112 I SUCCESS=0 S ^XTMP(NAMESPC,"CONFIG","FAILED")=$G(^XTMP(NAMESPC,"CONFIG","FAILED"))+1
113 I SUCCESS=1 S ^XTMP(NAMESPC,"CONFIG","SUCCESS")=$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))+1
114 Q
115STOPIT() ; Checks if user requested task to stop
116 N X,STOPIT
117 S STOPIT=0
118 S X=$$S^%ZTLOAD
119 I X D ;
120 .S STOPIT=1
121 .I $G(ZTSK) S ZTSTOP=1
122 Q STOPIT
123SEND(DFN) ; Send an ENROLLMENT/ELIGIBILITY QUERY to HEC for a veteran
124 ;Output: returns 1 on success, 0 on failure.
125 ;
126 I '$$ON^DGENQRY Q 0
127 N LAST,DGQRY,MSGID,SUCCESS,SENT,ERROR
128 S SUCCESS=1,ERROR=""
129 I '$$LOCK^DGENQRY($G(DFN)) S SUCCESS=0
130 S LAST=$$FINDLAST^DGENQRY(DFN) ; Find latest Enr. Query Log IEN
131 I LAST,$$GET^DGENQRY(LAST,.DGQRY) ;
132 D:SUCCESS
133 .S SENT=$$MSG^DGENQRY1(DFN,.MSGID,.ERROR)
134 .I 'SENT S SUCCESS=0 Q
135 .S DGQRY("DFN")=DFN
136 .S DGQRY("SENT")=SENT
137 .S DGQRY("STATUS")=0
138 .S DGQRY("MSGID")=MSGID
139 .S DGQRY("NOTIFY")=$G(NOTIFY)
140 .S DGQRY("FIRST")=$S($G(FIRST):FIRST,1:SENT)
141 .S DGQRY("RESPONSE")=""
142 .S DGQRY("RESPONSEID")=""
143 .I '$$LOG^DGENQRY(.DGQRY) S SUCCESS=0 Q
144 D UNLOCK^DGENQRY($G(DFN))
145 Q SUCCESS
146ABORTMSG ; Send the user aborted message:
147 N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
148 S NAMESPC=$$NAMESPC
149 S NAMESPCN=$P(NAMESPC,"DG",2)
150 S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
151 S XMSUB="DG*5.3*"_NAMESPCN_": DOD CLEANUP - PROCESS STOPPED BY USER"
152 S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
153 S TMP(NAMESPCN,2)="------------------"
154 S TMP(NAMESPCN,3)=""
155 S TMP(NAMESPCN,4)="The cleanup process was aborted prematurely. Here is the current status:"
156 S TMP(NAMESPCN,5)=""
157 S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
158 S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","ABORT TIME")),"P")
159 S TMP(NAMESPCN,8)=""
160 S TMP(NAMESPCN,9)="Current Counts: "
161 S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
162 S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
163 S TMP(NAMESPCN,12)=" Percentage Completed: "_+$G(^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE"))_"%"
164 S TMP(NAMESPCN,13)=""
165 S TMP(NAMESPCN,14)=""
166 D ^XMD
167 Q
168DONEMSG ; Send the user aborted message:
169 N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
170 S NAMESPC=$$NAMESPC
171 S NAMESPCN=$P(NAMESPC,"DG",2)
172 S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
173 S XMSUB="DG*5.3*"_NAMESPCN_": DOD CLEANUP - SUMMARY REPORT"
174 S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
175 S TMP(NAMESPCN,2)="------------------"
176 S TMP(NAMESPCN,3)=""
177 S TMP(NAMESPCN,4)="The cleanup has run to completion. Here are the results:"
178 S TMP(NAMESPCN,5)=""
179 S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
180 S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","COMPLETE")),"P")
181 S TMP(NAMESPCN,8)=""
182 S TMP(NAMESPCN,9)="Current Counts: "
183 S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
184 S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
185 S TMP(NAMESPCN,12)=" Percentage Completed: 100%"
186 S TMP(NAMESPCN,13)=""
187 S TMP(NAMESPCN,14)=""
188 D ^XMD
189 Q
Note: See TracBrowser for help on using the repository browser.