1 | EAS126 ;ALB/PHH - EAS*1*26 POST-INSTALL ;05-27-2003
|
---|
2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**26**;MAR 15,2001
|
---|
3 | Q
|
---|
4 | EN ; Entry point for post-install
|
---|
5 | D FIXOPT,START
|
---|
6 | Q
|
---|
7 | RESET ; Reset the data for the cleanup process
|
---|
8 | K ^XTMP($$NAMESPC)
|
---|
9 | Q
|
---|
10 | TEST ; Simulate Live Run
|
---|
11 | N MODE
|
---|
12 | S MODE=0
|
---|
13 | START ; Start Processor
|
---|
14 | N NAMESPC,QTIME
|
---|
15 | S NAMESPC=$$NAMESPC
|
---|
16 | Q:$$RUNCHK(NAMESPC) ; Quit if already running or has run to completion
|
---|
17 | Q:$$QTIME(.QTIME)
|
---|
18 | S:$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) MODE=^XTMP(NAMESPC,"CONFIG","RUN MODE")
|
---|
19 | S:'$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) ^XTMP(NAMESPC,"CONFIG","RUN MODE")=$S($G(MODE)=0:0,1:1)
|
---|
20 | S ^XTMP(NAMESPC,"CONFIG","USER")=$S($G(DUZ)'="":DUZ,1:"UNKNOWN")
|
---|
21 | S:'$$QUEUE(QTIME) ^XTMP(NAMESPC,"CONFIG","RUNNING")=""
|
---|
22 | Q
|
---|
23 | NAMESPC() ; API returns the name space for this patch
|
---|
24 | Q "EAS26"
|
---|
25 | RUNCHK(NAMESPC) ; Check to see if clean up is already running
|
---|
26 | Q:NAMESPC="" 1 ; Name Space must be defined
|
---|
27 | Q:$D(^XTMP(NAMESPC,"CONFIG","RUNNING")) 1
|
---|
28 | Q:$D(^XTMP(NAMESPC,"CONFIG","COMPLETE")) 1
|
---|
29 | Q 0
|
---|
30 | QTIME(WHEN) ; Get the run time for queuing
|
---|
31 | N %,%H,%I,X
|
---|
32 | D NOW^%DTC
|
---|
33 | S WHEN=$P(%,".")_"."_$E($P(%,".",2),1,4)
|
---|
34 | Q 0
|
---|
35 | QUEUE(ZTDTH) ; Queue the process
|
---|
36 | N NAMESPC,QUEERR,ZTDESC,ZTRTN,ZTSK
|
---|
37 | S NAMESPC=$$NAMESPC
|
---|
38 | S QUEERR=0
|
---|
39 | S ZTRTN="CLEAN^EAS1"_$P(NAMESPC,"EAS",2)
|
---|
40 | S ZTDESC=NAMESPC_" - Patient Merge Cleanup Process"
|
---|
41 | S ZTIO=""
|
---|
42 | D ^%ZTLOAD
|
---|
43 | K ^XTMP(NAMESPC,"CONFIG","ZTSK")
|
---|
44 | I '$D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Unable to queue post-install process.",QUEERR=1
|
---|
45 | I $D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Post-install queued. Task ID: "_$G(ZTSK)
|
---|
46 | D HOME^%ZIS
|
---|
47 | Q QUEERR
|
---|
48 | CLEAN ; Actual cleanup process
|
---|
49 | N NAMESPC,MODE,USER,TASKID,%,%H,%I,X,X1,X2,CHKCNT,TMSWT,TOTPR12,DGPR12
|
---|
50 | S NAMESPC=$$NAMESPC
|
---|
51 | K ^XTMP(NAMESPC,"CONFIG","ABORT TIME")
|
---|
52 | S MODE=$G(^XTMP(NAMESPC,"CONFIG","RUN MODE"),0)
|
---|
53 | S USER=$G(^XTMP(NAMESPC,"CONFIG","USER"),"UNKNOWN")
|
---|
54 | S TASKID=$G(^XTMP(NAMESPC,"CONFIG","ZTSK"),"UNKNOWN")
|
---|
55 | ;
|
---|
56 | I '$D(^XTMP(NAMESPC,0)) D
|
---|
57 | .K ^XTMP(NAMESPC)
|
---|
58 | .S ^XTMP(NAMESPC,"CONFIG","DGPR12")=0
|
---|
59 | .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=0
|
---|
60 | .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=0
|
---|
61 | .S ^XTMP(NAMESPC,"CONFIG","RUN MODE")=MODE
|
---|
62 | .S ^XTMP(NAMESPC,"CONFIG","USER")=USER
|
---|
63 | .S ^XTMP(NAMESPC,"CONFIG","ZTSK")=TASKID
|
---|
64 | .D NOW^%DTC
|
---|
65 | .S ^XTMP(NAMESPC,"CONFIG","START TIME")=%
|
---|
66 | .S X1=$$DT^XLFDT,X2=90
|
---|
67 | .D C^%DTC
|
---|
68 | .S ^XTMP(NAMESPC,0)=X_U_$$DT^XLFDT_U_NAMESPC_" - PATIENT MERGE CLEANUP"
|
---|
69 | ;
|
---|
70 | S CHKCNT=250,(ZTSTOP,TMSWT)=0,TOTPR12=+$P($G(^DGPR(408.12,0)),"^",4)
|
---|
71 | S DGPR12=$G(^XTMP(NAMESPC,"CONFIG","DGPR12"))
|
---|
72 | F S DGPR12=$O(^DGPR(408.12,DGPR12)) Q:'DGPR12!(TMSWT) D
|
---|
73 | .D PROC(DGPR12)
|
---|
74 | .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))+1
|
---|
75 | .S ^XTMP(NAMESPC,"CONFIG","DGPR12")=DGPR12
|
---|
76 | .I TOTPR12 D
|
---|
77 | ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))/TOTPR12
|
---|
78 | ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$P((^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")*100),".")
|
---|
79 | .I +$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))#CHKCNT=0 D
|
---|
80 | ..S TMSWT=$$STOPIT()
|
---|
81 | ..I TMSWT D
|
---|
82 | ...S ZTSTOP=1
|
---|
83 | ...N %,%H,%I,X
|
---|
84 | ...D NOW^%DTC
|
---|
85 | ...S ^XTMP(NAMESPC,"CONFIG","ABORT TIME")=%
|
---|
86 | ...D ABORTMSG
|
---|
87 | ;
|
---|
88 | I 'DGPR12,'TMSWT D
|
---|
89 | .N %,%H,%I,X
|
---|
90 | .D NOW^%DTC
|
---|
91 | .S ^XTMP(NAMESPC,"CONFIG","COMPLETE")=%
|
---|
92 | .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=100
|
---|
93 | .D DONEMSG
|
---|
94 | ;
|
---|
95 | K ^XTMP(NAMESPC,"CONFIG","RUNNING")
|
---|
96 | Q
|
---|
97 | PROC(DGPR12) ; Process the DGPR12
|
---|
98 | N NAMESPC,NODE0,DFN,PERSON,DATA,DIE,DA,DR,X
|
---|
99 | S NAMESPC=$$NAMESPC()
|
---|
100 | S NODE0=$G(^DGPR(408.12,DGPR12,0))
|
---|
101 | Q:NODE0=""
|
---|
102 | S DFN=$P(NODE0,"^")
|
---|
103 | Q:DFN=""
|
---|
104 | S PERSON=$P(NODE0,"^",3)
|
---|
105 | I PERSON'="",PERSON["DPT",DFN=$P(PERSON,";"),'$D(^DGPR(408.12,"C",PERSON,DGPR12)) D
|
---|
106 | .S DATA(.03)=$$GET1^DIQ(408.12,DGPR12_",",.01,"I")_";DPT("
|
---|
107 | .S DIE="^DGPR(408.12,",DA=DGPR12,DR=".03////^S X=DATA(.03)"
|
---|
108 | .D:MODE ^DIE
|
---|
109 | .S ^XTMP(NAMESPC,"CONFIG","ANOMALY")=$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))+1
|
---|
110 | .S ^XTMP(NAMESPC,"DATA",DGPR12)=""
|
---|
111 | Q
|
---|
112 | STOPIT() ; Checks if user requested task to stop
|
---|
113 | N X,STOPIT
|
---|
114 | S STOPIT=0
|
---|
115 | S X=$$S^%ZTLOAD
|
---|
116 | I X D ;
|
---|
117 | .S STOPIT=1
|
---|
118 | .I $G(ZTSK) S ZTSTOP=1
|
---|
119 | Q STOPIT
|
---|
120 | ABORTMSG ; Send the user aborted message:
|
---|
121 | N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
|
---|
122 | S NAMESPC=$$NAMESPC
|
---|
123 | S NAMESPCN=$P(NAMESPC,"EAS",2)
|
---|
124 | S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
|
---|
125 | S XMSUB="EAS*1.0*"_NAMESPCN_": PATIENT MERGE CLEANUP - PROCESS STOPPED BY USER"
|
---|
126 | S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
|
---|
127 | S TMP(NAMESPCN,2)="------------------"
|
---|
128 | S TMP(NAMESPCN,3)=""
|
---|
129 | S TMP(NAMESPCN,4)="The cleanup process was aborted prematurely. Here is the current status:"
|
---|
130 | S TMP(NAMESPCN,5)=""
|
---|
131 | S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
|
---|
132 | S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","ABORT TIME")),"P")
|
---|
133 | S TMP(NAMESPCN,8)=""
|
---|
134 | S TMP(NAMESPCN,9)="Current Counts: "
|
---|
135 | S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
|
---|
136 | S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))
|
---|
137 | S TMP(NAMESPCN,12)=" Percentage Completed: "_+$G(^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE"))_"%"
|
---|
138 | S TMP(NAMESPCN,13)=""
|
---|
139 | S TMP(NAMESPCN,14)=""
|
---|
140 | D ^XMD
|
---|
141 | Q
|
---|
142 | DONEMSG ; Send the user done message:
|
---|
143 | N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
|
---|
144 | S NAMESPC=$$NAMESPC
|
---|
145 | S NAMESPCN=$P(NAMESPC,"EAS",2)
|
---|
146 | S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
|
---|
147 | S XMSUB="EAS*1.0*"_NAMESPCN_": PATIENT MERGE CLEANUP - SUMMARY REPORT"
|
---|
148 | S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
|
---|
149 | S TMP(NAMESPCN,2)="------------------"
|
---|
150 | S TMP(NAMESPCN,3)=""
|
---|
151 | S TMP(NAMESPCN,4)="The cleanup has run to completion. Here are the results:"
|
---|
152 | S TMP(NAMESPCN,5)=""
|
---|
153 | S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
|
---|
154 | S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","COMPLETE")),"P")
|
---|
155 | S TMP(NAMESPCN,8)=""
|
---|
156 | S TMP(NAMESPCN,9)="Current Counts: "
|
---|
157 | S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
|
---|
158 | S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))
|
---|
159 | S TMP(NAMESPCN,12)=" Percentage Completed: 100%"
|
---|
160 | S TMP(NAMESPCN,13)=""
|
---|
161 | S TMP(NAMESPCN,14)=""
|
---|
162 | D ^XMD
|
---|
163 | Q
|
---|
164 | FIXOPT ; Fix 'EAS MT 30 DAY LETTER PRINT' option
|
---|
165 | N OPTNAME,OPTIEN,DIE,DA,DR,X
|
---|
166 | S OPTNAME="EAS MT 30 DAY LETTER PRINT"
|
---|
167 | Q:'$D(^DIC(19,"B",OPTNAME))
|
---|
168 | S OPTIEN=0
|
---|
169 | F S OPTIEN=$O(^DIC(19,"B",OPTNAME,OPTIEN)) Q:'OPTIEN D
|
---|
170 | .S DIE="^DIC(19,",DA=OPTIEN,DR="25///^S X=""@"""
|
---|
171 | .D ^DIE
|
---|
172 | Q
|
---|