source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUP113.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1TIUP113 ; SLC/JAK - Post-Install for TIU*1*113 ;12/01/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**113**;Jun 20, 1997
3BUILD ; -- Rebuild SEARCH CATEGORIES so DIVISION is selectable
4 D KILL^TIUDD8
5 Q
6MAIN ; -- Control unit
7 N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
8 W !!,"PATCH TIU*1*113"
9 W !!,"Load the DIVISION field for TIU DOCUMENT file (#8925) entries.",!
10 S ZTRTN="SETDIV^TIUP113",ZTIO="",ZTSAVE("DUZ")=""
11 S ZTDESC="DIVISION field load for File #8925 - Patch 113"
12 D ^%ZTLOAD
13 I $G(ZTSK) D
14 . W !!,"A task has been queued in the background and a bulletin will be sent"
15 . W !,"to you upon completion of the task or if the task is stopped."
16 . W !!,"The task number is "_$G(ZTSK)_"."
17 Q
18SETDIV ; -- Automatically set division for documents
19 N TIUCNT,TIUDA,TIUS
20 S ^XTMP("TIUP113","T0")=$$NOW^XLFDT
21 ; Initialize re-start if check point exists
22 I +$G(^XTMP("TIUP113","CHKPT")) D
23 . S TIUDA=+$G(^XTMP("TIUP113","CHKPT"))
24 E D
25 . ; Initialize if not re-start
26 . S ^XTMP("TIUP113",0)=$$FMADD^XLFDT(DT,90)_U_DT
27 . S ^XTMP("TIUP113","EX")=0 F TIUS=1,2 S ^XTMP("TIUP113","EX",TIUS)=0
28 . S (TIUDA,^XTMP("TIUP113","CHKPT"))=0
29 K ^XTMP("TIUP113","STOP")
30 ;
31 ; Loop thru TIU Document entries
32 F S TIUDA=$O(^TIU(8925,TIUDA)) Q:+TIUDA'>0!($G(ZTSTOP)) D
33 . S TIUCNT=+$G(TIUCNT)+1
34 . ; Register activity in the ^XTMP("TIUP113", array
35 . S ^XTMP("TIUP113","CHKPT")=TIUDA
36 . ; Check if user requested to stop task
37 . I $G(TIUCNT)>1000 D
38 . . I $$S^%ZTLOAD S ZTSTOP=1
39 . . E S TIUCNT=0
40 . ;
41 . I +$P($G(^TIU(8925,TIUDA,12)),U,12) Q
42 . N TIUDTYP,TIUEX
43 . S TIUDTYP=+$P($G(^TIU(8925,TIUDA,0)),U)
44 . ; -- Ignore records of (document type) type=component
45 . I TIUDTYP,$P($G(^TIU(8925.1,TIUDTYP,0)),U,4)="CO" Q
46 . ; -- Check if hospital location and entry date/time don't exist
47 . I '$D(^TIU(8925,TIUDA,12)) D SETEX(TIUDA,1) Q
48 . ; -- Get IFP from HL's Division
49 . N RESULT,TIUE,TIUHL,TIUDVHL,TIUIFP
50 . S (TIUDVHL,TIUE,TIUHL,TIUIFP)=0
51 . S TIUHL=+$P($G(^TIU(8925,TIUDA,12)),U,5) I TIUHL D
52 . . S TIUDVHL=+$P($G(^SC(TIUHL,0)),U,15) I TIUDVHL D
53 . . . S TIUE=+$P($G(^TIU(8925,TIUDA,12)),U) I TIUE D
54 . . . . S TIUIFP=+$$SITE^VASITE(TIUE,TIUDVHL) I TIUIFP>0 S RESULT=TIUIFP
55 . I 'TIUHL!('TIUDVHL)!('TIUE)!(TIUIFP<0) D
56 . . D SETEX(TIUDA,1)
57 . E D
58 . . D SETRSLT(TIUDA,RESULT)
59 ;
60SETCHKQ ; Send bulletin and re-set check point
61 I $G(ZTSTOP) S ^XTMP("TIUP113","STOP")=$$NOW^XLFDT
62 S ^XTMP("TIUP113","T1")=$$NOW^XLFDT
63 S ^XTMP("TIUP113","EX")=+$G(^XTMP("TIUP113","EX",1))+(+$G(^XTMP("TIUP113","EX",2)))
64 ;
65 D MAIL^TIUP113P
66 ;
67 I '$G(ZTSTOP) S ^XTMP("TIUP113","CHKPT")=""
68 Q
69SETEX(TIUDA,TIUEX) ; -- Load ^XTMP with exception entries
70 ; Input -- TIUDA TIU Document file (#8925) IEN
71 ; TIUEX Exception types:
72 ; 1=Cannot determine DIVISION from Hospital Location
73 ; 2=Attempted to load DIVISION data but entry in use
74 ; (value=1) (see SETRSLT for value=2)
75 S ^XTMP("TIUP113","EX",TIUEX,TIUDA)=""
76 S ^XTMP("TIUP113","EX",TIUEX)=+$G(^XTMP("TIUP113","EX",TIUEX))+1
77 Q
78SETRSLT(TIUDA,RESULT) ; -- Set DIVISION data and ADIV x-ref
79 ; Input -- TIUDA TIU Document file (#8925) IEN
80 ; RESULT Institution file (#4) IEN
81 N DIE,DR,DA
82 L +^TIU(8925,+TIUDA):5 E D Q
83 . S ^XTMP("TIUP113","EX",2,TIUDA)=RESULT
84 . S ^XTMP("TIUP113","EX",2)=+$G(^XTMP("TIUP113","EX",2))+1
85 S DIE="^TIU(8925,",DA=+TIUDA,DR="1212////^S X=RESULT"
86 D ^DIE
87 L -^TIU(8925,+TIUDA)
88 Q
89UPDATE ; -- Exception entries
90 W !,"If you did not receive a mail message which indicated the post-"
91 W !,"install COMPLETED, you must invoke MAIN^TIUP113 from Programmer"
92 W !,"mode before following the instructions below.",!
93 N DIR,DIRUT,DTOUT,DUOUT,X,Y
94 N RESULT,TIUCHC,TIUDA,TIUDIV,TIUI,TIUJ,TIUK,TIUNOEX,TIUOUT,TIUS
95 S TIUOUT=0 F TIUK=7,9,18 S DIR("A",TIUK)=""
96 S DIR("A",1)="Below are listed the choices for what action(s) to take"
97 S DIR("A",2)="on the exception entries. It is recommended you select"
98 S DIR("A",3)="choice 3 and also possibly choice 2. The numbers can be"
99 S DIR("A",4)="selected by commas, dashes, or a combination of both."
100 S DIR("A",5)="You can invoke this entry point (>D UPDATE^TIUP113)"
101 S DIR("A",6)="as often as you wish."
102 S DIR("A",8)="CHOICES:"
103 S DIR("A",10)="1- Exit and do not load Division for exception entries."
104 S DIR("A",11)="2- For exception entries in which Division could not be"
105 S DIR("A",12)=" determined from the Hospital Location, prompt me to"
106 S DIR("A",13)=" select one Division and load entries with this"
107 S DIR("A",14)=" Division. (type A)"
108 S DIR("A",15)="3- For exception entries that were previously in use,"
109 S DIR("A",16)=" try to load Division data again. (type B)"
110 S DIR("A")="Select (a) NUMBER(S)"
111 S DIR(0)="L^1:3" D ^DIR G EXIT:$D(DIRUT) S TIUCHC=Y
112 I TIUCHC[1 Q
113 I TIUCHC[2 N DIR,X,Y S DIR(0)="P^40.8" D ^DIR G EXIT:Y'>0!$D(DIRUT) D
114 . S TIUDIV=+Y,TIUIFP=+$$SITE^VASITE(,TIUDIV),RESULT=TIUIFP
115 F TIUI=1:1:($L(TIUCHC,",")-1) D
116 . S TIUS=$P(TIUCHC,",",TIUI)
117 . I TIUS=2 D NOEX(TIUS,1) I 'TIUNOEX D
118 . . N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
119 . . S ZTRTN="TWOA^TIUP113",ZTIO=""
120 . . S (ZTSAVE("DUZ"),ZTSAVE("RESULT"))=""
121 . . S ZTDESC="Choice 2 UPDATE^TIUP113 - Patch 113"
122 . . D ^%ZTLOAD
123 . . I $G(ZTSK) D
124 . . . W !!,"A task has been queued in the background for Choice 2."
125 . . . W !,"The task number is "_$G(ZTSK)_"."
126 . . Q
127 . I TIUS=3 D THREEB(TIUS)
128 Q
129TWOA ; -- Load entries with selection
130 ; Input -- RESULT Institution file (#4) IEN
131 N TIUCNT
132 S TIUDA=0 D
133 . F S TIUDA=$O(^XTMP("TIUP113","EX",1,TIUDA)) Q:+TIUDA'>0!($G(ZTSTOP)) D
134 . . D SETRSLT(TIUDA,RESULT)
135 . . K ^XTMP("TIUP113","EX",1,TIUDA)
136 . . S TIUCNT=+$G(TIUCNT)+1
137 . . ; Check if user requested to stop task
138 . . I $G(TIUCNT)>1000 D
139 . . . I $$S^%ZTLOAD S ZTSTOP=1
140 . . . E S TIUCNT=0
141 ;
142 I '$G(ZTSTOP) S ^XTMP("TIUP113","EX",1)=0
143 Q
144THREEB(TIUS) ; -- Try to load locked entries
145 ; Input -- TIUS Choice 3
146 S TIUDA=0 N RESULT D NOEX(TIUS,2) I 'TIUNOEX D
147 . W !!,"...Choice 3 - UPDATING NOW....",!!
148 . F S TIUDA=$O(^XTMP("TIUP113","EX",2,TIUDA)) Q:+TIUDA'>0 D
149 . . S RESULT=$G(^XTMP("TIUP113","EX",2,TIUDA))
150 . . D SETRSLT(TIUDA,RESULT)
151 . . I +$P($G(^TIU(8925,TIUDA,12)),U,12) K ^XTMP("TIUP113","EX",2,TIUDA)
152 . S ^XTMP("TIUP113","EX",2)=0
153 Q
154NOEX(TIUS,TIUJ) ; -- No exceptions
155 ; Input -- TIUS Choice 2 or 3
156 ; -- TIUJ Exception entry types A (1) or B (2)
157 S TIUNOEX=0
158 I +$G(^XTMP("TIUP113","EX",TIUJ))=0 D
159 . W !,"Choice: ",TIUS,"-type ",$S(TIUJ=2:"B",1:"A")
160 . W " has no exceptions."
161 . S TIUNOEX=1
162 Q
163DEVICE ; -- Device Selection
164 N TIUMSG,TIUOUT S TIUOUT=0
165 S TIUMSG(1)="Remember to finish the post-install after review of"
166 S TIUMSG(2)="the output by invoking UPDATE^TIUP113"
167 D MES^XPDUTL(.TIUMSG)
168 W !! S %ZIS="Q" D ^%ZIS I POP K POP S TIUOUT=1 G EXIT
169 I $D(IO("Q")) D Q
170 . S ZTRTN="PRINT^TIUP113"
171 . S ZTDESC="TIU*1*113 POST-INSTALL EXCEPTION LIST"
172 . D ^%ZTLOAD W !,$S($D(ZTSK):"Request queued",1:"Request Cancelled!")
173 . K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,%ZIS
174 . D HOME^%ZIS
175 U IO D PRINT,^%ZISC
176 Q
177PRINT ; -- Print job
178 N TIUDA,TIUIFP,TIUOUT,TIUS,TIUST S TIUOUT=0
179 I $D(ZTQUEUED) S ZTREQ="@"
180 F TIUS=1,2 Q:TIUOUT S TIUDA=0 D
181 . I TIUS=2 D ASK Q:TIUOUT
182 . D HDR W !!,$P($T(EXHDR+TIUS),";",3)
183 . I +$G(^XTMP("TIUP113","EX",TIUS))=0 W !?4,"No exceptions." Q
184 . F S TIUDA=$O(^XTMP("TIUP113","EX",TIUS,TIUDA)) Q:+TIUDA'>0!(TIUOUT) D
185 . . I $Y>(IOSL-4) D ASK Q:TIUOUT D HDR W !!,$P($T(EXHDR+TIUS),";",3)
186 . . W !?4,TIUDA
187 . . S TIUST=$P($G(^TIU(8925,+TIUDA,0)),U,5) I TIUST>0 D
188 . . . W " ",$P($G(^TIU(8925.6,+TIUST,0)),U)
189 . . I TIUS=2 D
190 . . . S TIUIFP=$G(^XTMP("TIUP113","EX",2,TIUDA))
191 . . . W ": ",$$GET1^DIQ(4,TIUIFP,.01)
192 Q
193ASK ; -- End of Page
194 I IO=IO(0),$E(IOST)="C" D
195 . W ! N DIR,X,Y S DIR(0)="E"
196 . D ^DIR I $D(DUOUT)!$D(DTOUT) S TIUOUT=1
197 Q
198HDR ; -- Header
199 N LNE,TIUNOW
200 D NOW^%DTC S Y=% X ^DD("DD") S TIUNOW=Y
201 W @IOF,"TIU*1*113 POST-INSTALL EXCEPTION LIST - Printed: ",TIUNOW
202 W !!,"Listed below are TIU DOCUMENT entry numbers that did not get "
203 W "DIVISION data",!,"loaded. If a division name is listed with an "
204 W "entry number, the record was",!,"in use and the division data "
205 W "could not be loaded."
206 W ! S LNE="",$P(LNE,"-",(IOM-1))="" W LNE
207 Q
208EXHDR ; -- Exception entry headers
209 ;;A. Cannot determine DIVISION from Hospital Location:
210 ;;B. Attempted to load DIVISION data but entry in use:
211 ;
212EXIT ; -- Exits here if ^ at: DEVICE prompt,
213 ; -- two UPDATE areas, or at End of Page
214 I TIUOUT D
215 . W $C(7),$C(7),!!,"OK...please remember to finish the post-install "
216 . W "by: >D UPDATE^TIUP113"
217 Q
Note: See TracBrowser for help on using the repository browser.