source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SD53P495.m@ 1383

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1SD53P495 ;ALB/RBS - ENV/POST-INSTALL FOR PATCH SD*5.3*495 ; 5/2/07 12:24pm
2 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
3 Q
4ENV ;Environment check
5 S XPDABORT=""
6 ;checks programmer variables
7 D PROGCHK(.XPDABORT)
8 ;check if install is running
9 D ISRUNING(.XPDABORT)
10 I XPDABORT="" K XPDABORT
11 Q
12POST ;Post-Install
13 D POST1
14 ;Check for SCOUT file
15 I '$D(^ANUSB(626140)) D Q
16 . D NOFILE
17 D TASK
18 Q
19POST1 ;Set parameter value
20 N SDDAYS,SDERR,SDPARM
21 S SDPARM="SDSC SITE PARAMETER",SDDAYS=30
22 D EN^XPAR("DIV",SDPARM,1,SDDAYS,.SDERR)
23 D BMES^XPDUTL("******")
24 I '$G(SDERR) D
25 . D MES^XPDUTL(SDPARM_" parameter set to "_SDDAYS_" days SUCCESSFULLY.")
26 E D
27 . D MES^XPDUTL(SDPARM_" parameter set FAILED.")
28 D MES^XPDUTL("******")
29 Q
30START ;Background job entry point
31 N SDAIEN,SDANUSB,SDX,SDFDAIEN,SDARAY,SDERAY,SDSAVE
32 N SDTOT,SDTOT1,SDTOT2,SDTOT3,SDENCPTR,SDCKCNT,SDSTOP,SDENT,SDFIL,DFN
33 D XTMP
34 ;seed var's if Re-Run
35 I $D(^XTMP("SD53P495","TOT")) D
36 . S SDTOT=+$G(^XTMP("SD53P495","TOT"))
37 . S SDTOT1=+$G(^XTMP("SD53P495","TOT1"))
38 . S SDTOT2=+$G(^XTMP("SD53P495","TOT2"))
39 . S SDTOT3=+$G(^XTMP("SD53P495","TOT3"))
40 . S (SDSAVE,SDENCPTR)=+$G(^XTMP("SD53P495","ENCOUNTER"))
41 E D
42 . S (SDAIEN,SDENCPTR,SDSAVE,SDTOT,SDTOT1,SDTOT2,SDTOT3)=0
43 S SDCKCNT=100,SDSTOP=0
44 F S SDENCPTR=$O(^ANUSB(626140,"B",SDENCPTR)) Q:'SDENCPTR D Q:SDSTOP
45 . S SDSAVE=SDENCPTR
46 . K SDANUSB,SDARAY,SDERAY,SDENT
47 . I +SDTOT#SDCKCNT=0,$$S^%ZTLOAD() S SDSTOP=1 Q
48 . S SDAIEN=$O(^ANUSB(626140,"B",SDENCPTR,""),-1)
49 . Q:'$G(SDAIEN)
50 . S SDANUSB=$G(^ANUSB(626140,SDAIEN,0))
51 . Q:'SDANUSB
52 . S SDTOT=SDTOT+1
53 . I $D(^SDSC(409.48,SDENCPTR,0)) S SDTOT3=SDTOT3+1 Q
54 . I '$$GETOE^SDOE(SDENCPTR) D Q
55 . . S DFN=$P(SDANUSB,U,11) D DEM^VADPT S DFN=$E(VADM(1),1,15)
56 . . S SDENT=DFN_" "_$$FMTE^XLFDT($P(SDANUSB,U,7),2)
57 . . D UPXTMP(SDENCPTR,"NO (O/P) ENCOUNTER RECORD (#409.68)",SDENT) S SDTOT2=SDTOT2+1
58 . D GETS^DIQ(626140,SDAIEN_",","**","I","SDARAY","SDERAY")
59 . I $D(SDERAY) D Q
60 . . S SDENT=$G(SDERAY("DIERR",1,"TEXT",1))
61 . . D UPXTMP(SDENCPTR,"NO (SCOUT) FILE DATA (#626140)",SDENT) S SDTOT2=SDTOT2+1
62 . S SDFIL=$$FILE(SDENCPTR,SDAIEN,.SDARAY)
63 . I '+SDFIL D Q
64 . . D UPXTMP(SDENCPTR,"FILING ERROR TO (#409.48)",$P(SDFIL,"^",2)) S SDTOT2=SDTOT2+1
65 . E D
66 . . S SDTOT1=SDTOT1+1
67 I SDSTOP D
68 . S ^XTMP("SD53P495","STOPPED")=$$NOW^XLFDT()
69 . S ZTSTOP=1
70 E D
71 . S ^XTMP("SD53P495","COMPLETED")=$$NOW^XLFDT()
72 S ^XTMP("SD53P495","ENCOUNTER")=SDSAVE
73 S ^XTMP("SD53P495","TOT")=SDTOT,^XTMP("SD53P495","TOT1")=SDTOT1
74 S ^XTMP("SD53P495","TOT2")=SDTOT2,^XTMP("SD53P495","TOT3")=SDTOT3
75 K ^XTMP("SD53P495","RUNNING") D KVA^VADPT
76 D SENDMSG(SDSTOP)
77 Q
78FILE(SDENCPTR,SDAIEN,SDARAY) ;file new entry
79 ; create #409.48 file
80 ; Input:
81 ; SDENCPTR - [required] O/P Encounter file pointer (#409.68)
82 ; SDAIEN - [required] IEN of (#626140) record to convert
83 ; SDARAY - [required] Array of Internal values of all fields
84 ; Output:
85 ; Function Value - returns 1 on success, 0 on failure and error msg
86 I '+$G(SDENCPTR)!'+$G(SDAIEN)!('$D(SDARAY)) Q 0
87 N SDERR,SDFDA,SDFLD,SDFDAIEN,SDI,SDIENS,SDNUM,SDSTR,SDSTR1,SDSUB
88 N DIC,DICR,DIE,DIERR,DD,DG,DO,DR,DA
89 ; DINUM=X setup so new file IEN = O/P Encounter IEN
90 S SDFDAIEN(1)=SDENCPTR
91 ; setup main fields
92 S SDIENS="+1,",SDAIEN=SDAIEN_","
93 S SDSTR=".01^.02^.03^.04^.05^.06^.07^.08^.09^.1^.11^.12"
94 F SDI=1:1:12 D
95 . S SDFLD=$P(SDSTR,U,SDI)
96 . S SDFDA(409.48,SDIENS,SDFLD)=$G(SDARAY(626140,SDAIEN,SDFLD,"I"))
97 S SDFDA(409.48,SDIENS,.13)=1 ;SCOUT was always a 1 (SC)
98 ; setup fields of (#409.481) multiple
99 I $D(SDARAY(626140.01)) D
100 . S SDSTR1=".01^.02^.03^.04^.05^.06",SDNUM=1,(SDSUB,SDIENS)=""
101 . F S SDSUB=$O(SDARAY(626140.01,SDSUB)) Q:SDSUB="" D
102 . . S SDNUM=SDNUM+1
103 . . F SDI=1:1:6 S SDFLD=$P(SDSTR1,U,SDI) D
104 . . . S SDIENS="+"_SDNUM_",+1,"
105 . . . S SDFDA(409.481,SDIENS,SDFLD)=$G(SDARAY(626140.01,SDSUB,SDFLD,"I"))
106 D UPDATE^DIE("","SDFDA","SDFDAIEN","SDERR")
107 Q $S($D(SDERR):0,1:1)_"^"_$S($D(SDERR):$G(SDERR("DIERR",1,"TEXT",1)),1:"")
108SENDMSG(SDSTOP) ;send MailMan msg to patch installer
109 N DIFROM,SDMSG,SDTXT,SDLN,XMY,XMDUZ,XMSUB,XMTEXT,XMDUN,XMZ
110 K ^TMP("SD53P495",$J)
111 S XMSUB="SD*5.3*495 (SCOUT) FILE CONVERSION REPORT"
112 S XMTEXT="^TMP(""SD53P495"",$J,",XMDUZ=.5,(XMY(DUZ),XMY(XMDUZ))=""
113 S SDLN=0
114 D ADD(.SDLN,"Patch: SD*5.3*495 Automated Service Connected Designation")
115 D ADD(.SDLN," "),ADD(.SDLN,"************")
116 D ADD(.SDLN,"The existing Class III (SCOUT) file, ANU SERVICE CONNECTED CHANGES (#626140),")
117 D ADD(.SDLN,"which contains O/P Encounter records that have been compiled for additional")
118 D ADD(.SDLN,"Service Connected (SC) review, has been used to create a new Class I file")
119 D ADD(.SDLN,"which will provide the same functionality.")
120 D ADD(.SDLN," ")
121 D ADD(.SDLN,"Only valid O/P Encounter records from the Class III (SCOUT) file,")
122 D ADD(.SDLN,"ANU SERVICE CONNECTED CHANGES (#626140), have been filed into")
123 D ADD(.SDLN,"the new SDSC SERVICE CONNECTED CHANGES (#409.48) file.")
124 D ADD(.SDLN," ")
125 D ADD(.SDLN,"The new Automated Service Connected Designation (ASCD) Menu Options")
126 D ADD(.SDLN,"enable user access to the O/P Encounter records in the (#409.48) file.")
127 D ADD(.SDLN,"************"),ADD(.SDLN," "),ADD(.SDLN," ")
128 D ADD(.SDLN,"SUMMARY OF PROCESSING RESULTS:")
129 D ADD(.SDLN,"==============================")
130 D ADD(.SDLN," ")
131 D ADD(.SDLN,"<<< The Class III (SCOUT) File Conversion has "_$S(+$G(SDSTOP):"NOT ",1:"")_"Completed. >>>")
132 I +$G(SDSTOP) D
133 . D ADD(.SDLN," Please restart the post-install process from the following")
134 . D ADD(.SDLN," programmer's prompt:")
135 . D ADD(.SDLN," D POST^SD53P495")
136 D ADD(.SDLN," "),ADD(.SDLN," ")
137 D ADD(.SDLN," DATE/TIME TASK STARTED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","START")),"P"))
138 I $G(SDSTOP) D
139 . D ADD(.SDLN," DATE/TIME TASK STOPPED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","STOPPED")),"P"))
140 E D
141 . D ADD(.SDLN,"DATE/TIME TASK COMPLETED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","COMPLETED")),"P"))
142 I $D(^XTMP("SD53P495","LAST RUN")) D
143 . D ADD(.SDLN," DATE/TIME LAST RUN: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","LAST RUN")),"P"))
144 D ADD(.SDLN," "),ADD(.SDLN," ")
145 D ADD(.SDLN," TOTAL O/P ENCOUNTER RECORDS FOUND: "_+$G(^XTMP("SD53P495","TOT")))
146 I +$G(^XTMP("SD53P495","TOT3")) D
147 . D ADD(.SDLN," TOTAL RECORDS PREVIOUSLY CONVERTED: "_+$G(^XTMP("SD53P495","TOT3")))
148 D ADD(.SDLN," TOTAL O/P ENCOUNTER RECORDS CONVERTED: "_+$G(^XTMP("SD53P495","TOT1")))
149 D ADD(.SDLN,"TOTAL O/P ENCOUNTER RECORDS NOT CONVERTED: "_+$G(^XTMP("SD53P495","TOT2")))
150 I +$G(^XTMP("SD53P495","TOT2")) D
151 . D ADD(.SDLN," :")
152 . N SDSUB,SDIEN,SDENT
153 . S (SDSUB,SDIEN)=""
154 . F S SDSUB=$O(^XTMP("SD53P495","TOT2",SDSUB)) Q:SDSUB="" D
155 . . D ADD(.SDLN," REASON NOT CONVERTED: "_SDSUB)
156 . . D ADD(.SDLN," O/P ENCOUNTER IEN:")
157 . . F S SDIEN=$O(^XTMP("SD53P495","TOT2",SDSUB,SDIEN)) Q:'SDIEN D
158 . . . S SDENT=$E(^XTMP("SD53P495","TOT2",SDSUB,SDIEN),1,30)
159 . . . D ADD(.SDLN," : "_SDIEN_"-"_SDENT)
160 . . D ADD(.SDLN," :")
161 D ADD(.SDLN," <END OF REPORT> :")
162 D ^XMD
163 K ^TMP("SD53P495",$J)
164 Q
165ADD(SDLN,SDTXT) ;add line
166 Q:$L(SDTXT)'>0
167 S SDLN=$G(SDLN)+1
168 S ^TMP("SD53P495",$J,SDLN)=SDTXT
169 Q
170PROGCHK(XPDABORT) ;checks programmer variables
171 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
172 . D BMES^XPDUTL("******")
173 . D MES^XPDUTL("Your programming variables are not set up properly.")
174 . D MES^XPDUTL("Installation aborted.")
175 . D MES^XPDUTL("******")
176 . S XPDABORT=2
177 Q
178ISRUNING(XPDABORT) ;check if running
179 I +$G(^XTMP("SD53P495","RUNNING")) D
180 . D BMES^XPDUTL("******")
181 . D MES^XPDUTL("This patch is currently being Installed. Try later.")
182 . D MES^XPDUTL("Installation aborted...")
183 . D MES^XPDUTL("******")
184 . S XPDABORT=2
185 Q
186NOFILE ;no File
187 D BMES^XPDUTL("******")
188 D MES^XPDUTL("The Class III (SCOUT) File Conversion is NOT necessary because")
189 D MES^XPDUTL("the ANU SERVICE CONNECTED CHANGES (#626140) file does not exist")
190 D MES^XPDUTL("on this system.")
191 D MES^XPDUTL("Post-Install process terminated...")
192 D MES^XPDUTL("******")
193 Q
194TASK ;run TaskMan
195 N ZTSK,ZTDTH,ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTREQ,ZTSTOP,SDSTOP
196 S SDSTOP=+$G(^XTMP("SD53P495","STOPPED"))
197 S ZTRTN="START^SD53P495"
198 S ZTDESC="SD*5.3*495 (SCOUT) FILE CONVERSION PROCESSING"
199 S ZTIO="",ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")=""
200 D ^%ZTLOAD
201 D BMES^XPDUTL("******")
202 I '$D(ZTSK) D
203 . D MES^XPDUTL("Unable to schedule TaskMan task to run the Class III (SCOUT) File")
204 . D MES^XPDUTL("Conversion.")
205 . D BMES^XPDUTL("Please re-run Post-Install routine POST^SD53P495 from")
206 . D MES^XPDUTL("the programmer prompt.")
207 . ;
208 E D
209 . D MES^XPDUTL("Task "_ZTSK_" has been "_$S(+SDSTOP:"Re-",1:"")_"started to run the Class III (SCOUT) File")
210 . D MES^XPDUTL("Conversion.")
211 . I SDSTOP D
212 . . D MES^XPDUTL(" <<< The last task run was STOPPED on "_$$FMTE^XLFDT(SDSTOP,"P")_". >>>")
213 . D BMES^XPDUTL("You will receive a MailMan message when this task is completed")
214 . D MES^XPDUTL("or if it has been manually stopped.")
215 D MES^XPDUTL("******")
216 Q
217XTMP ;setup ^XTMP to control output for 90 days
218 I $D(^XTMP("SD53P495",0)) D
219 . S ^XTMP("SD53P495","LAST RUN")=$G(^XTMP("SD53P495","START"))
220 E D
221 . N SDX
222 . S SDX=$$FMADD^XLFDT($$NOW^XLFDT(),90)_U_$$NOW^XLFDT()
223 . S SDX=SDX_"^SD*5.3*495 (SCOUT) FILE CONVERSION PROCESSING"
224 . S ^XTMP("SD53P495",0)=SDX
225 S ^XTMP("SD53P495","START")=$$NOW^XLFDT()
226 S ^XTMP("SD53P495","RUNNING")="1"
227 Q
228UPXTMP(SDENCPTR,NODE,SDENT) ;add to ^XTMP
229 ; Input:
230 ; SDENCPTR - Encounter IEN
231 ; NODE - Unique subscript
232 ; Output: none
233 Q:'$G(SDENCPTR)
234 I $G(NODE)="" S NODE="UNKNOWN"
235 S ^XTMP("SD53P495","TOT2",NODE,SDENCPTR)=$G(SDENT)
236 Q
Note: See TracBrowser for help on using the repository browser.