| 1 | LEXXFI ; 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
 | 
|---|
| 32 | EN ;   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
 | 
|---|
| 37 | ONE ;   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
 | 
|---|
| 51 | ALL ;   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 |  ;              
 | 
|---|
| 68 | POST ; Entry Point for Post-Install Message
 | 
|---|
| 69 |  N LEXPOST S LEXPOST=""
 | 
|---|
| 70 |  ;            
 | 
|---|
| 71 | SEND ; 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
 | 
|---|
| 83 | MAIL ; 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
 | 
|---|
| 107 | MAILQ ; Quit Mail
 | 
|---|
| 108 |  D KILL K %Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ
 | 
|---|
| 109 |  Q
 | 
|---|
| 110 |  ;               
 | 
|---|
| 111 |  ; Miscellaneous
 | 
|---|
| 112 | HDR ;   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
 | 
|---|
| 133 | TIM ;   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
 | 
|---|
| 139 | ENV(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
 | 
|---|
| 145 | CLR ;   Clear ^TMP("LEXCS",$J)
 | 
|---|
| 146 |  K ^TMP("LEXCS",$J) Q
 | 
|---|
| 147 | KILL ;   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 |  ;;
 | 
|---|
| 153 | FILES ;;
 | 
|---|
| 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
 | 
|---|