1 | ACKQIPST ;HCIOFO/BH-Version 3 Post Installation routine ; 04/01/99
|
---|
2 | ;;3.0;QUASAR;;Feb 11, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
4 | ;
|
---|
5 | N ACKTEST S ACKTEST=$$GET1^DIQ(509850.8,1,.1,"I")
|
---|
6 | I ACKTEST="S"!(ACKTEST="D") D Q
|
---|
7 | . S ACKTXT(1)="Installation Routine has already been run."
|
---|
8 | . S ACKTXT(2)="Therefore will only attempt to add The PIMS 'Clinic Workload' report option"
|
---|
9 | . S ACKTXT(3)="to the Quasar Reports menu. Will not update CDR Report parameter."
|
---|
10 | . S ACKTXT(4)=" " D MES^XPDUTL(.ACKTXT) K ACKTXT
|
---|
11 | . S ACKCHK=$$NEWCP^XPDUTL("POST1","OPTN^ACKQIPST")
|
---|
12 | . Q ; Return to KIDS & let KIDS run the checkpoint.
|
---|
13 | ;
|
---|
14 | K ^TMP("ACKQIPST","INSTALLV3")
|
---|
15 | ; Setup chkpoints for KIDS.
|
---|
16 | ;
|
---|
17 | N ACKCHK
|
---|
18 | S ACKCHK=$$NEWCP^XPDUTL("POST1","REPORT^ACKQIPST")
|
---|
19 | ; Updte Params file with input for CDR report. Virgin
|
---|
20 | ; site - just set up site level on Params file,set Interface to PCE
|
---|
21 | ; & CDR param values
|
---|
22 | ;
|
---|
23 | S ACKCHK=$$NEWCP^XPDUTL("POST2","MAIN^ACKQIPST")
|
---|
24 | ; Update Visit file with Appmnt Time, Div & Proc Vol. Also
|
---|
25 | ; store Divs and Clins for later update into site params file.
|
---|
26 | ;
|
---|
27 | S ACKCHK=$$NEWCP^XPDUTL("POST21")
|
---|
28 | ; Keep track of visit date subscript of Visit file B X Ref
|
---|
29 | ;
|
---|
30 | S ACKCHK=$$NEWCP^XPDUTL("POST22")
|
---|
31 | ; Keep track of visit IEN subscript of Visit file B X Ref
|
---|
32 | ;
|
---|
33 | S ACKCHK=$$NEWCP^XPDUTL("POST24")
|
---|
34 | ; Keep track of secs within Apnt Time Gen.
|
---|
35 | ;
|
---|
36 | S ACKCHK=$$NEWCP^XPDUTL("POST25")
|
---|
37 | ; Keep track of mins within Appt Time Gen.
|
---|
38 | ;
|
---|
39 | S ACKCHK=$$NEWCP^XPDUTL("POST26")
|
---|
40 | ; Keep track of hrs within Appt Time Gen.
|
---|
41 | ;
|
---|
42 | S ACKCHK=$$NEWCP^XPDUTL("POST3","PARAMSD^ACKQIPST")
|
---|
43 | ; Update Div Values used within the above visits onto the site
|
---|
44 | ; params file
|
---|
45 | ;
|
---|
46 | S ACKCHK=$$NEWCP^XPDUTL("POST31")
|
---|
47 | ; Keep track of Divs within the Temp global of Divs & Clins
|
---|
48 | ;
|
---|
49 | S ACKCHK=$$NEWCP^XPDUTL("POST4","PARAMSC^ACKQIPST")
|
---|
50 | ; Update Clin Vals used within the above visits onto the site
|
---|
51 | ; params file
|
---|
52 | ;
|
---|
53 | S ACKCHK=$$NEWCP^XPDUTL("POST41")
|
---|
54 | ; Keep track of Divs within the Temp global of Divs & Clins
|
---|
55 | ;
|
---|
56 | S ACKCHK=$$NEWCP^XPDUTL("POST42")
|
---|
57 | ; Keep track of Clins within the Temp global of Divs & Clins
|
---|
58 | ;
|
---|
59 | S ACKCHK=$$NEWCP^XPDUTL("POST5","OPTN^ACKQIPST")
|
---|
60 | S ACKCHK=$$NEWCP^XPDUTL("POST6","STAFF^ACKQIPS1")
|
---|
61 | ;
|
---|
62 | Q ;Return to KIDS & let KIDS run the checkpoints.
|
---|
63 | ;
|
---|
64 | REPORT ; Virgin Install : set up the .01 node
|
---|
65 | ; Update CDR Report param
|
---|
66 | ;
|
---|
67 | S ^TMP("ACKQIPST","SKIP")="0"
|
---|
68 | I $$GET1^DIQ(509850.8,1,.01)="" D
|
---|
69 | . S ^TMP("ACKQIPST","SKIP")="1" ; Keep note of Skip
|
---|
70 | . S DIC="^ACK(509850.8,",DIC(0)="L",DLAYGO=509850.8,ACKLAYGO="",DINUM=1
|
---|
71 | . S X="1" D FILE^DICN ; Do a FM call to set up Site .01 level
|
---|
72 | . ;
|
---|
73 | . D BMES^XPDUTL("Virgin Install - Site level being created on A&SP Site Parameters file.")
|
---|
74 | . ;
|
---|
75 | . K ACKARR
|
---|
76 | . S ACKARR(509850.8,1_",",2)="0" D FILE^DIE("K","ACKARR")
|
---|
77 | . D BMES^XPDUTL("Interface to PCE Parameter set to 'NO'.")
|
---|
78 | . K DA,DIK,ACKARR
|
---|
79 | ;
|
---|
80 | I '$D(XPDQUES("POS1")) D
|
---|
81 | . D BMES^XPDUTL("CDR Report parameter not entered - Install will use default value of 'Site'.")
|
---|
82 | . S XPDQUES("POS1")="S" Q
|
---|
83 | ;
|
---|
84 | N ACKARR
|
---|
85 | S ACKARR(509850.8,1_",",.1)=XPDQUES("POS1") D FILE^DIE("K","ACKARR")
|
---|
86 | D BMES^XPDUTL("CDR Report Parameter updated.")
|
---|
87 | K DA,DIK
|
---|
88 | Q
|
---|
89 | ;
|
---|
90 | MAIN I ^TMP("ACKQIPST","SKIP") Q ; Virgin Site
|
---|
91 | ;
|
---|
92 | ; Loop thru the B X ref
|
---|
93 | ; Clin val is used to get a Div value
|
---|
94 | ; A unique time is gererated
|
---|
95 | ; Updates Procs new Vol field with 1
|
---|
96 | ; Appt. Time & the vols are updated within one FM call
|
---|
97 | ; Divn is updated last
|
---|
98 | ; All the above fields run X ref that sets the LAST EDITED IN
|
---|
99 | ; QUASAR field to NOW
|
---|
100 | ;
|
---|
101 | N ACKTXT,ACKAY1,ACKAY2,ACKAY3,ACKAY7,ACKAY8,ACKAY9,ACKQSEC,ACKARR1
|
---|
102 | K TARGET
|
---|
103 | S POST21=+$$PARCP^XPDUTL("POST21") ; VISIT DATE
|
---|
104 | S POST22=+$$PARCP^XPDUTL("POST22") ; VISIT IEN
|
---|
105 | S ACKS=+$$PARCP^XPDUTL("POST24")
|
---|
106 | S ACKM=+$$PARCP^XPDUTL("POST25")
|
---|
107 | S ACKH=+$$PARCP^XPDUTL("POST26")
|
---|
108 | ;
|
---|
109 | S ACKTXT(1)=" "
|
---|
110 | S ACKTXT(2)="Looping through A&SP Clinic Visit File updating all visits with an Appnt."
|
---|
111 | S ACKTXT(3)="Time and Division value & all visits Procedures with a Volume value."
|
---|
112 | S ACKTXT(4)=" " D MES^XPDUTL(.ACKTXT) K ACKTXT
|
---|
113 | ;
|
---|
114 | F S POST21=$O(^ACK(509850.6,"B",POST21)) Q:POST21="" D
|
---|
115 | . F S POST22=$O(^ACK(509850.6,"B",POST21,POST22)) Q:POST22="" D
|
---|
116 | . .;
|
---|
117 | . . S ACKQSEC=$$GET1^DIQ(509850.6,POST22_",",.25,"I")
|
---|
118 | . . I ACKQSEC'="" D
|
---|
119 | . . . S ACKARR1(509850.66,"+1,"_POST22_",",.01)=ACKQSEC
|
---|
120 | . . . D UPDATE^DIE("","ACKARR1","","")
|
---|
121 | . .;
|
---|
122 | . . S (ACKDIV,ACKCLIN)=""
|
---|
123 | . .; Derive Div from clinic
|
---|
124 | . . S ACKCLIN=$P($G(^ACK(509850.6,POST22,0)),U,6)
|
---|
125 | . . I ACKCLIN'="" S ACKDIV=$$GET1^DIQ(44,ACKCLIN_",",3.5,"I")
|
---|
126 | . .;
|
---|
127 | . .; Keep a list of all Divs with their Clins
|
---|
128 | . . I ACKCLIN'="",ACKDIV'="" S ^TMP("ACKQIPST","INSTALLV3",ACKDIV,ACKCLIN)=""
|
---|
129 | . .;---Generate Unique Appnt Time--
|
---|
130 | . . I ACKS=""!(ACKM="")!(ACKH="") S (ACKS,ACKM,ACKH)=0
|
---|
131 | . . I ACKS=60 S ACKS="0" S ACKM=+ACKM+1
|
---|
132 | . . I $L(ACKS)=1 S ACKS="0"_ACKS
|
---|
133 | . . S ACKTIME=ACKS
|
---|
134 | . . S ACKS=+ACKS+1
|
---|
135 | . . ;
|
---|
136 | . . I ACKM=60 S ACKM=0 S ACKH=+ACKH+1
|
---|
137 | . . I $L(ACKM)=1 S ACKM="0"_ACKM
|
---|
138 | . . ;
|
---|
139 | . . I ACKH=24 S ACKH="0"
|
---|
140 | . . I $L(ACKH)=1 S ACKH="0"_ACKH
|
---|
141 | . . S ACKTME="."_ACKH_ACKM_ACKTIME
|
---|
142 | . . ;
|
---|
143 | . . S AKAY7=+$$UPCP^XPDUTL("POST24",ACKS)
|
---|
144 | . . S ACKAY8=+$$UPCP^XPDUTL("POST25",ACKM)
|
---|
145 | . . S ACKAY9=+$$UPCP^XPDUTL("POST26",ACKH)
|
---|
146 | . .;---End of Appnt. Time Processing--
|
---|
147 | . . K ACKARR,TARGET,ERRMSG
|
---|
148 | . .; Do FM LIST to get all procs within the visit
|
---|
149 | . . D LIST^DIC(509850.61,","_POST22_",",".01","I","*","","","","","","TARGET","ERRMSG")
|
---|
150 | . . S POST23="" ;Initalise Proc IEN
|
---|
151 | . . F S POST23=$O(TARGET("DILIST",2,POST23)) Q:POST23="" D
|
---|
152 | . . .; Create an update array entry for each proc in the visit
|
---|
153 | . . . S ACKARR(509850.61,TARGET("DILIST",2,POST23)_","_POST22_",",.03)="1"
|
---|
154 | . .;
|
---|
155 | . .; Set update array with Appnt. Time
|
---|
156 | . . S ACKARR(509850.6,POST22_",",55)=ACKTME
|
---|
157 | . . D FILE^DIE("K","ACKARR") ;Run FM to update time & vols
|
---|
158 | . .;
|
---|
159 | . . K ACKARR ;Kill - Update vals have be updated onto visit file
|
---|
160 | . .;
|
---|
161 | . .; Set update array with Derived Div.
|
---|
162 | . . S ACKARR(509850.6,POST22_",",60)=ACKDIV
|
---|
163 | . . D FILE^DIE("K","ACKARR")
|
---|
164 | . . K ACKARR
|
---|
165 | . . S ACKAY1=+$$UPCP^XPDUTL("POST22",POST22)
|
---|
166 | . . Q
|
---|
167 | . S ACKAY2=+$$UPCP^XPDUTL("POST21",POST21)
|
---|
168 | . Q
|
---|
169 | ;
|
---|
170 | D BMES^XPDUTL("Update of A&SP Clinic Visit records Complete.")
|
---|
171 | D BMES^XPDUTL("Temporary file of Clinics and Divisions Created.")
|
---|
172 | Q
|
---|
173 | ;
|
---|
174 | PARAMSD ; Update site param file
|
---|
175 | I ^TMP("ACKQIPST","SKIP") Q ;Virgin Site
|
---|
176 | ;
|
---|
177 | N ACKAY4
|
---|
178 | ;
|
---|
179 | ; Get Use Local Clin Nos, Use C&P and Bypass Audio values from
|
---|
180 | ; Site level of Site Params file
|
---|
181 | ;
|
---|
182 | D BMES^XPDUTL("Commencing update of the A&SP Site Parameters file.")
|
---|
183 | ;
|
---|
184 | D GETS^DIQ(509850.8,1,".05;.07;.08","I","ACK","ERRMSG")
|
---|
185 | ;
|
---|
186 | S ACKLCN=$G(ACK(509850.8,"1,",.05,"I"))
|
---|
187 | S ACKCNP=$G(ACK(509850.8,"1,",.07,"I"))
|
---|
188 | S ACKBAU=$G(ACK(509850.8,"1,",.08,"I"))
|
---|
189 | ;
|
---|
190 | ; Loop thru Div. level of temp. file
|
---|
191 | ;
|
---|
192 | D BMES^XPDUTL("Looping through Division Level of the Temporary file creating new")
|
---|
193 | D BMES^XPDUTL("Division entries on the A&SP Site Parameters file.")
|
---|
194 | ;
|
---|
195 | S POST31=+$$PARCP^XPDUTL("POST31")
|
---|
196 | F S POST31=$O(^TMP("ACKQIPST","INSTALLV3",POST31)) Q:POST31="" D
|
---|
197 | . S ACKAY4=+$$UPCP^XPDUTL("POST31",POST31)
|
---|
198 | .; For each Div. Set a new Div. level entry in Site params
|
---|
199 | .;
|
---|
200 | . S DIC="^ACK(509850.8,"_1_",2,"
|
---|
201 | . S DIC(0)="L"
|
---|
202 | . S DIC("P")="509850.83P"
|
---|
203 | . S DA=POST31
|
---|
204 | . S DA(1)=1
|
---|
205 | . S X=POST31
|
---|
206 | . S DINUM=POST31
|
---|
207 | . D FILE^DICN K DIC,DA
|
---|
208 | .;
|
---|
209 | .; Set following vals into new div. level of site params file
|
---|
210 | .;
|
---|
211 | . K ACKARR
|
---|
212 | . S ACKARR(509850.83,POST31_",1,",.02)="I"
|
---|
213 | . S ACKARR(509850.83,POST31_",1,",.03)="0"
|
---|
214 | . S ACKARR(509850.83,POST31_",1,",.04)=ACKLCN
|
---|
215 | . S ACKARR(509850.83,POST31_",1,",.06)=ACKCNP
|
---|
216 | . S ACKARR(509850.83,POST31_",1,",.07)=ACKBAU
|
---|
217 | .;
|
---|
218 | . D FILE^DIE("K","ACKARR")
|
---|
219 | . K ACKARR
|
---|
220 | Q
|
---|
221 | ;
|
---|
222 | PARAMSC ; Loop thru Clins in temp file & add them to the
|
---|
223 | ; relevant Divs.
|
---|
224 | I ^TMP("ACKQIPST","SKIP") Q ;Virgin Site
|
---|
225 | ;
|
---|
226 | N ACKAY5,ACKAY6
|
---|
227 | S POST41=+$$PARCP^XPDUTL("POST41")
|
---|
228 | S POST42=+$$PARCP^XPDUTL("POST42")
|
---|
229 | ;
|
---|
230 | D BMES^XPDUTL("Looping through Clinic Level of the Temporary file creating new Clinic")
|
---|
231 | D BMES^XPDUTL("entries within the Divisions.")
|
---|
232 | ;
|
---|
233 | F S POST41=$O(^TMP("ACKQIPST","INSTALLV3",POST41)) Q:POST41="" D
|
---|
234 | . I '$D(^ACK(509850.8,1,2,POST41,0)) D BMES^XPDUTL("Error Setting up Division - "_$$GET1^DIQ(40.8,POST41,.01)) Q
|
---|
235 | . F S POST42=$O(^TMP("ACKQIPST","INSTALLV3",POST41,POST42)) Q:POST42="" D
|
---|
236 | . . S ACKAY5=+$$UPCP^XPDUTL("POST42",POST42)
|
---|
237 | . .; Set each clin into the Clin multiple within the Div.
|
---|
238 | . .; level of the site params file
|
---|
239 | . .; If first time thru create clin level
|
---|
240 | . .;
|
---|
241 | . . S DIC="^ACK(509850.8,"_1_",2,"_POST41_",1,"
|
---|
242 | . . S DIC(0)="L"
|
---|
243 | . . S DIC("P")="509850.831P"
|
---|
244 | . . S DA=POST42
|
---|
245 | . . S DA(1)=POST41
|
---|
246 | . . S DA(2)=1
|
---|
247 | . . S X=POST42
|
---|
248 | . . S DINUM=POST42
|
---|
249 | . . D FILE^DICN K DIC,DA
|
---|
250 | . S ACKAY6=+$$UPCP^XPDUTL("POST41",POST41)
|
---|
251 | ;
|
---|
252 | D BMES^XPDUTL("Clinic update complete.")
|
---|
253 | ;
|
---|
254 | ; Set PCE Interface param to False
|
---|
255 | K ACKARR
|
---|
256 | S ACKARR(509850.8,1_",",2)="0" D FILE^DIE("K","ACKARR")
|
---|
257 | D BMES^XPDUTL("Interface to PCE Parameter set to False.")
|
---|
258 | K DA,DIK
|
---|
259 | ;
|
---|
260 | K ^TMP("ACKQIPST","INSTALLV3") ; Kill temp Div/Clin file
|
---|
261 | D BMES^XPDUTL("Site Parameters file Update complete.")
|
---|
262 | Q
|
---|
263 | ;
|
---|
264 | OPTN ; Place the SDCLINIC WORKLOAD option on menu.
|
---|
265 | S X=$$ADD^XPDMENU("ACKQAS REPORTS","SDCLINIC WORKLOAD","",25)
|
---|
266 | I X D BMES^XPDUTL("The PIMS 'Clinic Workload' report option"),MES^XPDUTL("has been added to the QUASAR 'Reports Menu.'")
|
---|
267 | I 'X D BMES^XPDUTL("Sorry. I was unable to place the PIMS 'Clinic Workload'"),MES^XPDUTL("report option on the QUASAR 'Reports Menu.'")
|
---|
268 | K X
|
---|
269 | Q
|
---|
270 | ;
|
---|