source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXXFI.m@ 785

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

initial load of FOIAVistA 6/30/08 version

File size: 7.1 KB
Line 
1LEXXFI ; ISL/KER - File Info ; 04/22/2008
2 ;;2.0;LEXICON UTILITY;**32,46,49,41**;Sep 23, 1996;Build 34
3 Q
4 ;
5 ; Global Variables
6 ; ^LEXM(0
7 ; ^TMP("LEX*",$J SACC 2.3.2.5.1
8 ;
9 ; External References
10 ; DBIA 10086 HOME^%ZIS
11 ; DBIA 10089 ^%ZISC
12 ; DBIA 10063 ^%ZTLOAD
13 ; DBIA 2056 $$GET1^DIQ (file #200)
14 ; DBIA 10103 $$DT^XLFDT
15 ; DBIA 10103 $$FMTE^XLFDT
16 ; DBIA 10103 $$NOW^XLFDT
17 ; DBIA 10070 ^XMD
18 ; DBIA 4409 $$DTIME^XUP
19 ;
20 ; Newed by Post-Install LEX20nnP
21 ; LEXBUILD Build
22 ; LEXCRE Import Global Creation Date
23 ; LEXIGHF Import Global Host File
24 ; LEXLREV Revision
25 ; LEXREQP Required Patches
26 ; LEXSHORT Flag for Summary Install Message
27 ;
28 ; XPDA Newed by KIDS during Install
29 ; LEXCOUNT Flag Checked $D() and not used
30 ;
31 ; Checksums/Counts
32EN ; For One or More File(s)
33 N LEXENV,LEXMET,LEXID
34 S LEXENV=$$ENV
35 Q:+LEXENV'>0
36 S LEXMET=$$MT^LEXXFI7
37 I '$L(LEXMET) W !!," Checksum Files (One or All) not Selected" Q
38 I $L($T(@(LEXMET_"^LEXXFI")))>0 W ! D @LEXMET
39 Q
40ONE ; For ONE file
41 K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
42 N LEXBEG,LEXELP,LEXEND,LEXFC,LEXFI,LEXLDR,LEXMOD,LEXMUL,LEXNM,LEXTCS
43 N LEXTND,LEXTT,LEXTXT
44 S LEXBEG=$$TIC^LEXXFI8,LEXMUL=0,LEXMOD=0
45 S LEXFI=$$FI^LEXXFI7 I +LEXFI'>0 W !!," Checksum File not Selected" Q
46 S LEXLDR=$$LDR^LEXXFI8(LEXFI),LEXMOD=LEXMOD+($$MOD^LEXXFI8(LEXFI))
47 S LEXNM=$$FN^LEXXFI8(LEXFI),LEXTT=" "
48 W !
49 D ONE^LEXXFI2(LEXFI),ONE^LEXXFI3(LEXFI),ONE^LEXXFI5(LEXFI)
50 S LEXEND=$$TIC^LEXXFI8,LEXELP=$$ELAP^LEXXFI8(LEXBEG,LEXEND)
51 S:LEXELP="" LEXELP="00:00:00"
52 I +LEXBEG>0,LEXEND>0,$L(LEXELP) D TIM
53 K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
54 Q
55ALL ; For ALL files
56 K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
57 K ^TMP("LEXINS",$J),^TMP("LEXKID",$J) S:$D(ZTQUEUED) ZTREQ="@"
58 N LEXBEG,LEXELP,LEXEND,LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,LEXID
59 S LEXID="LEXKID",LEXBEG=$$TIC^LEXXFI8,LEXMUL=1,(LEXTND,LEXTCS,LEXMOD,LEXFC)=0
60 D:'$D(LEXPOST) HDR
61 I '$D(LEXSHORT) D ALL^LEXXFI5,ALL^LEXXFI2,ALL^LEXXFI3
62 S LEXEND=$$TIC^LEXXFI8 S LEXELP=$$ELAP^LEXXFI8(LEXBEG,LEXEND)
63 S:LEXELP="" LEXELP="00:00:00"
64 I +LEXBEG>0,LEXEND>0,$L(LEXELP) D TIM
65 D:$D(LEXSEND)!($D(LEXPOST)) EN^LEXXII K ^LEXM(0,"PRO") D:$D(ZTQUEUED) MAIL
66 I '$D(ZTQUEUED) D
67 . N LEXI S LEXI=0 F S LEXI=$O(^TMP("LEXKID",$J,LEXI)) Q:+LEXI=0 D
68 . . W !,$E($G(^TMP("LEXKID",$J,LEXI)),1,79)
69 D KILL
70 Q
71 ;
72POST ; Entry Point for Post-Install Message
73 N LEXPOST S LEXPOST=""
74 ;
75SEND ; Send Message
76 N LEXDESC,LEXENV,LEXP,LEXACCT,LEXPRO,LEXPRON,LEXSEND,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ
77 S LEXP=0,LEXENV=$$ENV
78 Q:+LEXENV'>0
79 S LEXSEND="",LEXPRON="LEXICAL SERVICES UPDATE",LEXPRO=$G(^LEXM(0,"PRO"))
80 S:+LEXPRO>0 LEXPRO=$$FMTE^XLFDT(LEXPRO,"1"),LEXP=1
81 S LEXACCT=$$U^LEXXFI7 S ZTSAVE("LEXACCT")=""
82 S ZTRTN="ALL^LEXXFI",ZTSAVE("LEXSEND")="",ZTSAVE("LEXPOST")=""
83 S:$D(LEXCOUNT) ZTSAVE("LEXCOUNT")=""
84 I $L($G(LEXPRO)),$L($G(LEXPRON)),+$G(LEXP)>0 S ZTSAVE("LEXPRO")="",ZTSAVE("LEXPRON")=""
85 S:$D(LEXLREV) ZTSAVE("LEXLREV")=""
86 S:$D(LEXREQP) ZTSAVE("LEXREQP")=""
87 S:$D(LEXBUILD) ZTSAVE("LEXBUILD")=""
88 S:$D(LEXSHORT) ZTSAVE("LEXSHORT")=""
89 S:$D(LEXIGHF) ZTSAVE("LEXIGHF")=""
90 S:$D(LEXCRE) ZTSAVE("LEXCRE")=""
91 S:$D(LEXID) ZTSAVE("LEXID")=""
92 S:$D(XPDA) ZTSAVE("XPDA")=""
93 S (LEXDESC,ZTDESC)="Post-Install File Counts "
94 S:$D(LEXSHORT) (LEXDESC,ZTDESC)="Post-Install Summary"
95 S ZTDTH=$H
96 S ZTIO=""
97 D ^%ZTLOAD
98 W:+($G(ZTSK))>0 !!," ",LEXDESC,!," Queued Task #",+($G(ZTSK)) W !
99 D ^%ZISC
100 Q
101MAIL ; Mail global array in message
102 N DIFROM,LEXPRI,LEXADR,LEXI,LEXM,LEXSUB,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ
103 I '$D(LEXSHORT),+$G(^TMP("LEXCS",$J,0))'>0 G MAILQ
104 K ^TMP("LEXMSG",$J)
105 S LEXSUB="Lexicon/ICD/CPT Installation"
106 S:$L($G(LEXBUILD)) LEXSUB=$G(LEXBUILD)_" Installation"
107 S LEXPRI=$$ADR^LEXXFI8
108 G:'$L(LEXPRI) MAILQ
109 S LEXPRI="G.LEXINS@"_LEXPRI
110 S LEXADR=$$GET1^DIQ(200,+($G(DUZ)),.01)
111 G:'$L(LEXADR) MAILQ
112 S U="^",XMSUB="LEX/ICD/CPT File Checksums - "_$$FMTE^XLFDT($$NOW^XLFDT)
113 S:$D(LEXCOUNT) XMSUB="LEX/ICD/CPT File Checksums/Counts - "_$$FMTE^XLFDT($$NOW^XLFDT)
114 S:$L($G(LEXBUILD)) XMSUB=$G(LEXBUILD)_" File Checksums"
115 I $L($G(LEXBUILD)),$D(LEXCOUNT) S XMSUB=$G(LEXBUILD)_" File Checksums/Counts"
116 S:$D(LEXPOST) XMSUB=LEXSUB
117 S LEXI=0 F S LEXI=$O(^TMP("LEXKID",$J,LEXI)) Q:+LEXI=0 D
118 . S LEXM=+($O(^TMP("LEXMSG",$J," "),-1))+1
119 . S ^TMP("LEXMSG",$J,LEXM,0)=$E($G(^TMP("LEXKID",$J,LEXI)),1,79)
120 . S ^TMP("LEXMSG",$J,0)=LEXM
121 K ^TMP("LEXKID",$J)
122 I '$D(LEXSHORT) S LEXI=0 F S LEXI=$O(^TMP("LEXCS",$J,LEXI)) Q:+LEXI=0 D
123 . S LEXM=+($O(^TMP("LEXMSG",$J," "),-1))+1
124 . S ^TMP("LEXMSG",$J,LEXM,0)=$E($G(^TMP("LEXCS",$J,LEXI)),1,79)
125 . S ^TMP("LEXMSG",$J,0)=LEXM
126 K ^TMP("LEXCS",$J) G:'$D(^TMP("LEXMSG",$J)) MAILQ G:+($G(^TMP("LEXMSG",$J,0)))'>0 MAILQ
127 S XMY(LEXPRI)="",XMY(LEXADR)="",XMTEXT="^TMP(""LEXMSG"",$J,",XMDUZ=.5 D ^XMD
128MAILQ ; Quit Mail
129 D KILL K XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ
130 Q
131 ;
132 ; Miscellaneous
133HDR ; Header
134 N LEXD,LEXP,LEXN,LEXT,LEXU,LEXA,LEXACT,LEXI,LEXF,LEXMUL S LEXF=0 S LEXACT=$G(LEXACCT),LEXA=""
135 S:$L($P(LEXACT,"^",1))&($L($P(LEXACT,"^",1))) LEXA=LEXACT
136 S:'$L($G(LEXA)) LEXA=$$U^LEXXFI7 S LEXU=$$P^LEXXFI7,LEXD=$$A^LEXXFI7 D TT^LEXXFI8("","Status")
137 S LEXT="" S:$L(LEXD) LEXT=" As of: "_LEXD
138 I $L(LEXD) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
139 S LEXT="",LEXI=$S($L($P(LEXA,"^",1)):"[",1:"")_$P(LEXA,"^",1)_$S($L($P(LEXA,"^",2)):"]",1:"")
140 S:$L(LEXI)&($L($P(LEXA,"^",2))) LEXI=LEXI_" "_$P(LEXA,"^",2)
141 S LEXT="" S:$L(LEXI) LEXT=" In Account: "_LEXI
142 I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
143 S LEXN=$P(LEXU,"^",1),LEXP=$P(LEXU,"^",2)
144 S LEXT="" S:$L(LEXN) LEXT=" Maint By: "
145 S:$L(LEXN) LEXT=LEXT_LEXN S:$L(LEXP)&($L(LEXN)) LEXT=LEXT_" "_LEXP
146 I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
147 S LEXT="" S:$L($G(LEXBUILD)) LEXT=" Build: "_$G(LEXBUILD)
148 I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
149 S LEXT="" I $L($G(LEXPRO))&($L($G(LEXPRON))) D
150 . S LEXT=" Protocol: "_LEXPRON_" invoked "_LEXPRO
151 . I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
152 D BL^LEXXFI8
153 Q
154TIM ; Time
155 Q:$D(LEXPOST) Q:+($G(LEXBEG))'>0 Q:+($G(LEXEND))'>0 Q:'$L($G(LEXELP))
156 D BL^LEXXFI8,TL^LEXXFI8((" Started: "_$TR($$FMTE^XLFDT(LEXBEG),"@"," ")))
157 D TL^LEXXFI8((" Finished: "_$TR($$FMTE^XLFDT(LEXEND),"@"," ")))
158 D TL^LEXXFI8((" Elapsed: "_LEXELP)),BL^LEXXFI8
159 Q
160ENV(X) ; Environment check
161 N LEXNM D HOME^%ZIS S U="^",DT=$$DT^XLFDT
162 I +($G(DUZ))'>0 W !!," User (DUZ) not defined",! Q 0
163 S LEXNM=$$GET1^DIQ(200,+($G(DUZ)),.01)
164 I '$L(LEXNM) W !!," Invalid User (DUZ) defined",! Q 0
165 S DTIME=$$DTIME^XUP(+($G(DUZ)))
166 Q 1
167CLR ; Clear ^TMP("LEXCS",$J)
168 K ^TMP("LEXCS",$J) Q
169KILL ; Kill all ^TMP("LEX**"
170 K ^TMP("LEXCNT",$J),^TMP("LEXCS",$J),^TMP("LEXI",$J)
171 K ^TMP("LEXINS",$J),^TMP("LEXMSG",$J),^TMP("LEXKID",$J)
172 Q
173 ;;
174 ;;
175FILES ;;
176 ;;;;757
177 ;;1;;757.001
178 ;;1;;757.01
179 ;;;;757.011
180 ;;;;757.014
181 ;;;;757.02
182 ;;;;757.03
183 ;;1;;757.04
184 ;;1;;757.05
185 ;;1;;757.06
186 ;;;;757.1
187 ;;;;757.11
188 ;;;;757.12
189 ;;;;757.13
190 ;;;;757.14
191 ;;1;;757.2
192 ;;1;;757.21
193 ;;;;757.3
194 ;;;;757.31
195 ;;1;;757.4
196 ;;1;;757.41
197 ;;;;80
198 ;;;;80.1
199 ;;;;80.3
200 ;;;;81
201 ;;;;81.1
202 ;;1;;81.2
203 ;;;;81.3
204 ;;
205 ;;
206 ;;
207 Q
Note: See TracBrowser for help on using the repository browser.