| [613] | 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
 | 
|---|