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

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1DG53695 ;ALB/PHH - DG*5.3*695 Patient Cleanup ; 2/24/2006
2 ;;5.3;Registration;**695**;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 "DG695"
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,ZTIO
34 S NAMESPC=$$NAMESPC
35 S QUEERR=0
36 S ZTRTN="CLEAN^DG53"_$P(NAMESPC,"DG",2)
37 S ZTDESC=NAMESPC_" - Patient 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,ZTSTOP,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_" - PATIENT 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,MODE)
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,MODE) ; Process the DFN
95 ; Check for orphan .3 and .11 nodes without the 0 node
96 N NAMESPC,FLAG,NODE,DA,DIK
97 Q:$D(^DPT(DFN,0))
98 S NAMESPC=$$NAMESPC,FLAG=1,NODE=0
99 F S NODE=$O(^DPT(DFN,NODE)) Q:'NODE!('FLAG) D
100 .I NODE'=.3,NODE'=.11 S FLAG=0
101 ;
102 ; If it's an orphan .3 and .11, clean it up
103 I FLAG D
104 .Q:'$D(^DPT(DFN,.11))
105 .Q:'$D(^DPT(DFN,.3))
106 .S DA=DFN,DIK="^DPT("
107 .S ^XTMP(NAMESPC,"DATA",DFN)=""
108 .S ^XTMP(NAMESPC,"CONFIG","ANOMALY")=$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))+1
109 .;
110 .; Save off old anomalies (just in case...)
111 .M ^XTMP(NAMESPC,"DATA",DFN,"PREVIOUS")=^DPT(DFN)
112 .;
113 .; Only delete if this is running in live mode
114 .I MODE D
115 ..D ^DIK
116 .S ^XTMP(NAMESPC,"CONFIG","SUCCESS")=$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))+1
117 Q
118STOPIT() ; Checks if user requested task to stop
119 N X,STOPIT
120 S STOPIT=0
121 S X=$$S^%ZTLOAD
122 I X D ;
123 .S STOPIT=1
124 .I $G(ZTSK) S ZTSTOP=1
125 Q STOPIT
126ABORTMSG ; Send the user aborted message:
127 N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
128 S NAMESPC=$$NAMESPC
129 S NAMESPCN=$P(NAMESPC,"DG",2)
130 S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
131 S XMSUB="DG*5.3*"_NAMESPCN_": PATIENT CLEANUP - PROCESS STOPPED BY USER"
132 S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
133 S TMP(NAMESPCN,2)="------------------"
134 S TMP(NAMESPCN,3)=""
135 S TMP(NAMESPCN,4)="The cleanup process was aborted prematurely. Here is the current status:"
136 S TMP(NAMESPCN,5)=""
137 S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
138 S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","ABORT TIME")),"P")
139 S TMP(NAMESPCN,8)=""
140 S TMP(NAMESPCN,9)="Current Counts: "
141 S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
142 S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
143 S TMP(NAMESPCN,12)=" Percentage Completed: "_+$G(^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE"))_"%"
144 S TMP(NAMESPCN,13)=""
145 S TMP(NAMESPCN,14)=""
146 D ^XMD
147 Q
148DONEMSG ; Send the user aborted message:
149 N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
150 S NAMESPC=$$NAMESPC
151 S NAMESPCN=$P(NAMESPC,"DG",2)
152 S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
153 S XMSUB="DG*5.3*"_NAMESPCN_": PATIENT CLEANUP - SUMMARY REPORT"
154 S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
155 S TMP(NAMESPCN,2)="------------------"
156 S TMP(NAMESPCN,3)=""
157 S TMP(NAMESPCN,4)="The cleanup has run to completion. Here are the results:"
158 S TMP(NAMESPCN,5)=""
159 S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
160 S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","COMPLETE")),"P")
161 S TMP(NAMESPCN,8)=""
162 S TMP(NAMESPCN,9)="Current Counts: "
163 S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
164 S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
165 S TMP(NAMESPCN,12)=" Percentage Completed: 100%"
166 S TMP(NAMESPCN,13)=""
167 S TMP(NAMESPCN,14)=""
168 D ^XMD
169 Q
Note: See TracBrowser for help on using the repository browser.