source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXXFI.m@ 1147

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

initial load of WorldVistAEHR

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