source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53658.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.6 KB
Line 
1DG53658 ;ALB/PHH - DG*5.3*658 ADDRESS CHANGE DT/TM Cleanup ; 9/19/2005
2 ;;5.3;Registration;**658**;Aug 13, 1993
3 Q
4PREINST ; Pre-Install process to delete the old X-Ref trigger in
5 ; PATIENT file #2 for ADDRESS CHANGE SOURCE field #.119
6 N DGFILE,DGFIELD,DGTRGNUM,DGUPDOUT
7 S DGFILE=2,DGFIELD=.119,DGTRGNUM=1
8 D DELIX^DDMOD(DGFILE,DGFIELD,DGTRGNUM,"K","DGUPDOUT")
9 Q
10RESET ; Reset the data for the cleanup process
11 K ^XTMP($$NAMESPC)
12 Q
13TEST ; Simulate Live Run
14 N MODE
15 S MODE=0
16START ; Start Processor
17 N NAMESPC,QTIME
18 S NAMESPC=$$NAMESPC
19 Q:$$RUNCHK(NAMESPC) ; Quit if already running or has run to completion
20 Q:$$QTIME(.QTIME)
21 S:$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) MODE=^XTMP(NAMESPC,"CONFIG","RUN MODE")
22 S:'$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) ^XTMP(NAMESPC,"CONFIG","RUN MODE")=$S($G(MODE)=0:0,1:1)
23 S ^XTMP(NAMESPC,"CONFIG","USER")=$S($G(DUZ)'="":DUZ,1:"UNKNOWN")
24 S:'$$QUEUE(QTIME) ^XTMP(NAMESPC,"CONFIG","RUNNING")=""
25 Q
26NAMESPC() ; API returns the name space for this patch
27 Q "DG658"
28RUNCHK(NAMESPC) ; Check to see if clean up is already running
29 Q:NAMESPC="" 1 ; Name Space must be defined
30 Q:$D(^XTMP(NAMESPC,"CONFIG","RUNNING")) 1
31 Q:$D(^XTMP(NAMESPC,"CONFIG","COMPLETE")) 1
32 Q 0
33QTIME(WHEN) ; Get the run time for queuing
34 N %,%H,%I,X
35 D NOW^%DTC
36 S WHEN=$P(%,".")_"."_$E($P(%,".",2),1,4)
37 Q 0
38QUEUE(ZTDTH) ; Queue the process
39 N NAMESPC,QUEERR,ZTDESC,ZTRTN,ZTSK,ZTIO
40 S NAMESPC=$$NAMESPC
41 S QUEERR=0
42 S ZTRTN="CLEAN^DG53"_$P(NAMESPC,"DG",2)
43 S ZTDESC=NAMESPC_" - Address Cleanup Process"
44 S ZTIO=""
45 D ^%ZTLOAD
46 K ^XTMP(NAMESPC,"CONFIG","ZTSK")
47 I '$D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Unable to queue post-install process.",QUEERR=1
48 I $D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Post-install queued. Task ID: "_$G(ZTSK)
49 D HOME^%ZIS
50 Q QUEERR
51CLEAN ; Actual cleanup process
52 N NAMESPC,MODE,USER,TASKID,%,%H,%I,X,X1,X2,CHKCNT,ZTSTOP,TMSWT,TOTDPT,DFN
53 S NAMESPC=$$NAMESPC
54 K ^XTMP(NAMESPC,"CONFIG","ABORT TIME")
55 S MODE=$G(^XTMP(NAMESPC,"CONFIG","RUN MODE"),0)
56 S USER=$G(^XTMP(NAMESPC,"CONFIG","USER"),"UNKNOWN")
57 S TASKID=$G(^XTMP(NAMESPC,"CONFIG","ZTSK"),"UNKNOWN")
58 ;
59 I '$D(^XTMP(NAMESPC,0)) D
60 .K ^XTMP(NAMESPC)
61 .S ^XTMP(NAMESPC,"CONFIG","DFN")=0
62 .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=0
63 .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=0
64 .S ^XTMP(NAMESPC,"CONFIG","RUN MODE")=MODE
65 .S ^XTMP(NAMESPC,"CONFIG","USER")=USER
66 .S ^XTMP(NAMESPC,"CONFIG","ZTSK")=TASKID
67 .D NOW^%DTC
68 .S ^XTMP(NAMESPC,"CONFIG","START TIME")=%
69 .S X1=$$DT^XLFDT,X2=90
70 .D C^%DTC
71 .S ^XTMP(NAMESPC,0)=X_U_$$DT^XLFDT_U_NAMESPC_" - ADDRESS CLEANUP"
72 ;
73 S CHKCNT=250,(ZTSTOP,TMSWT)=0,TOTDPT=+$P($G(^DPT(0)),"^",4)
74 S DFN=$G(^XTMP(NAMESPC,"CONFIG","DFN"))
75 F S DFN=$O(^DPT(DFN)) Q:'DFN!(TMSWT) D
76 .D PROC(DFN)
77 .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))+1
78 .S ^XTMP(NAMESPC,"CONFIG","DFN")=DFN
79 .I TOTDPT D
80 ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))/TOTDPT
81 ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$P((^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")*100),".")
82 .I +$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))#CHKCNT=0 D
83 ..S TMSWT=$$STOPIT()
84 ..I TMSWT D
85 ...S ZTSTOP=1
86 ...N %,%H,%I,X
87 ...D NOW^%DTC
88 ...S ^XTMP(NAMESPC,"CONFIG","ABORT TIME")=%
89 ...D ABORTMSG
90 ;
91 I 'DFN,'TMSWT D
92 .N %,%H,%I,X
93 .D NOW^%DTC
94 .S ^XTMP(NAMESPC,"CONFIG","COMPLETE")=%
95 .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=100
96 .D DONEMSG
97 ;
98 K ^XTMP(NAMESPC,"CONFIG","RUNNING")
99 Q
100PROC(DFN) ; Process the DFN
101 N NAMESPC,ADDRDTTM,RXFILLDT,DIE,DA,DR
102 S NAMESPC=$$NAMESPC
103 S ADDRDTTM=$P($G(^DPT(DFN,.11)),"^",13)
104 S RXFILLDT=$O(^PSRX("ACP",DFN,""),-1)
105 ;
106 ; If the ADDRESS CHANGE DT/TM field #.118 is null, set it to
107 ; ISSUE DATE field #1 in the PRESCRIPTION file #52. Also update
108 ; it, if it is older than the ISSUE DATE.
109 I ADDRDTTM=""!(ADDRDTTM<RXFILLDT) D
110 .S ^XTMP(NAMESPC,"DATA",DFN)=ADDRDTTM
111 .S ^XTMP(NAMESPC,"CONFIG","ANOMALY")=$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))+1
112 .S ^XTMP(NAMESPC,"CONFIG","DFN")=DFN
113 .S ADDRDTTM=RXFILLDT
114 .;
115 .; Set default date = 12-31-2003 if no entry is found in file #52.
116 .I ADDRDTTM="" D
117 ..S ADDRDTTM=3031231
118 ..S ^XTMP(NAMESPC,"CONFIG","NO-52")=$G(^XTMP(NAMESPC,"CONFIG","NO-52"))+1
119 .;
120 .S DIE="^DPT(",DA=DFN,DR=".118///^S X=ADDRDTTM"
121 .D:MODE ^DIE
122 .S $P(^XTMP(NAMESPC,"DATA",DFN),"^",2)=ADDRDTTM
123 .S ^XTMP(NAMESPC,"CONFIG","SUCCESS")=$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))+1
124 Q
125STOPIT() ; Checks if user requested task to stop
126 N X,STOPIT
127 S STOPIT=0
128 S X=$$S^%ZTLOAD
129 I X D ;
130 .S STOPIT=1
131 .I $G(ZTSK) S ZTSTOP=1
132 Q STOPIT
133ABORTMSG ; Send the user aborted message:
134 N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
135 S NAMESPC=$$NAMESPC
136 S NAMESPCN=$P(NAMESPC,"DG",2)
137 S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
138 S XMSUB="DG*5.3*"_NAMESPCN_": ADDRESS CLEANUP - PROCESS STOPPED BY USER"
139 S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
140 S TMP(NAMESPCN,2)="------------------"
141 S TMP(NAMESPCN,3)=""
142 S TMP(NAMESPCN,4)="The cleanup process was aborted prematurely. Here is the current status:"
143 S TMP(NAMESPCN,5)=""
144 S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
145 S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","ABORT TIME")),"P")
146 S TMP(NAMESPCN,8)=""
147 S TMP(NAMESPCN,9)="Current Counts: "
148 S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
149 S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
150 S TMP(NAMESPCN,12)=" Percentage Completed: "_+$G(^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE"))_"%"
151 S TMP(NAMESPCN,13)=""
152 S TMP(NAMESPCN,14)=""
153 D ^XMD
154 Q
155DONEMSG ; Send the user aborted message:
156 N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
157 S NAMESPC=$$NAMESPC
158 S NAMESPCN=$P(NAMESPC,"DG",2)
159 S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
160 S XMSUB="DG*5.3*"_NAMESPCN_": ADDRESS CLEANUP - SUMMARY REPORT"
161 S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
162 S TMP(NAMESPCN,2)="------------------"
163 S TMP(NAMESPCN,3)=""
164 S TMP(NAMESPCN,4)="The cleanup has run to completion. Here are the results:"
165 S TMP(NAMESPCN,5)=""
166 S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
167 S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","COMPLETE")),"P")
168 S TMP(NAMESPCN,8)=""
169 S TMP(NAMESPCN,9)="Current Counts: "
170 S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
171 S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
172 S TMP(NAMESPCN,12)=" Percentage Completed: 100%"
173 S TMP(NAMESPCN,13)=""
174 S TMP(NAMESPCN,14)=""
175 D ^XMD
176 Q
Note: See TracBrowser for help on using the repository browser.