- LEXXFI ;ISL/KER - File Info ;05/23/2017
- ;;2.0;LEXICON UTILITY;**32,46,49,41,59,73,80,103**;Sep 23, 1996;Build 2
- ;
- ; Global Variables
- ; ^LEXM(0) N/A
- ; ^TMP("LEX*",$J) SACC 2.3.2.5.1
- ; ^TMP("LEXCNT") SACC 2.3.2.5.1
- ; ^TMP("LEXCS") SACC 2.3.2.5.1
- ; ^TMP("LEXI") SACC 2.3.2.5.1
- ; ^TMP("LEXINS") SACC 2.3.2.5.1
- ; ^TMP("LEXKID") SACC 2.3.2.5.1
- ; ^TMP("LEXMSG") SACC 2.3.2.5.1
- ;
- ; External References
- ; $$DTIME^XUP ICR 4409
- ; $$DT^XLFDT ICR 10103
- ; $$FMTE^XLFDT ICR 10103
- ; $$GET1^DIQ ICR 2056
- ; $$NOW^XLFDT ICR 10103
- ; HOME^%ZIS ICR 10086
- ; ^%ZISC ICR 10089
- ; ^%ZTLOAD ICR 10063
- ; ^XMD ICR 10070
- ;
- ; Newed by Post-Install LEX20nnP
- ; LEXBUILD Build
- ; LEXCRE Import Global Creation Date
- ; LEXIGHF Import Global Host File
- ; LEXLREV Revision
- ; LEXREQP Required Patches
- ; LEXSHORT Flag for Summary Install Message
- ;
- ; Newed by Post-Install LEXXGI
- ; LEXPROC Protocol Name
- ; LEXRES Install Results
- ; LEXSTART Install Start Time
- ;
- ; Other
- ; XPDA Newed by KIDS during Install
- ; LEXCOUNT Flag Checked $D() and not used
- ;
- Q
- ; Checksums/Counts
- EN ; For One or More File(s)
- N LEXENV,LEXMET,LEXID
- S LEXENV=$$ENV
- Q:+LEXENV'>0
- S LEXMET=$$MT^LEXXFI7
- I '$L(LEXMET) W !!," Checksum Files (One or All) not Selected" Q
- I $L($T(@(LEXMET_"^LEXXFI")))>0 W ! D @LEXMET
- Q
- ONE ; For ONE file
- K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
- N LEXBEG,LEXELP,LEXEND,LEXFC,LEXFI,LEXLDR,LEXMOD,LEXMUL,LEXNM,LEXTCS
- N LEXTND,LEXTT,LEXTXT
- S LEXBEG=$$TIC^LEXXFI8,LEXMUL=0,LEXMOD=0
- S LEXFI=$$FI^LEXXFI7 I +LEXFI'>0 W !!," Checksum File not Selected" Q
- S LEXLDR=$$LDR^LEXXFI8(LEXFI),LEXMOD=LEXMOD+($$MOD^LEXXFI8(LEXFI))
- S LEXNM=$$FN^LEXXFI8(LEXFI),LEXTT=" "
- W !
- D ONE^LEXXFI2(LEXFI),ONE^LEXXFI3(LEXFI),ONE^LEXXFI5(LEXFI)
- S LEXEND=$$TIC^LEXXFI8,LEXELP=$$ELAP^LEXXFI8(LEXBEG,LEXEND)
- S:LEXELP="" LEXELP="00:00:00"
- I +LEXBEG>0,LEXEND>0,$L(LEXELP) D TIM
- K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
- Q
- ALL ; For ALL files
- K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
- K ^TMP("LEXINS",$J),^TMP("LEXKID",$J) S:$D(ZTQUEUED) ZTREQ="@"
- N LEXBEG,LEXELP,LEXEND,LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,LEXID
- S LEXID="LEXKID",LEXBEG=$$TIC^LEXXFI8,LEXMUL=1,(LEXTND,LEXTCS,LEXMOD,LEXFC)=0
- D:'$D(LEXPOST) HDR
- I '$D(LEXSHORT) D ALL^LEXXFI5,ALL^LEXXFI2,ALL^LEXXFI3
- S LEXEND=$$TIC^LEXXFI8 S LEXELP=$$ELAP^LEXXFI8(LEXBEG,LEXEND)
- S:LEXELP="" LEXELP="00:00:00"
- I +LEXBEG>0,LEXEND>0,$L(LEXELP) D TIM
- D:$D(LEXSEND)!($D(LEXPOST)) EN^LEXXII K ^LEXM(0,"PRO") D:$D(ZTQUEUED) MAIL
- I '$D(ZTQUEUED) D
- . N LEXI S LEXI=0 F S LEXI=$O(^TMP("LEXKID",$J,LEXI)) Q:+LEXI=0 D
- . . W !,$E($G(^TMP("LEXKID",$J,LEXI)),1,79)
- D KILL
- Q
- ;
- POST ; Entry Point for Post-Install Message
- N LEXPOST S LEXPOST=""
- ;
- SEND ; Send Message
- N LEXDESC,LEXENV,LEXP,LEXACCT,LEXPRO,LEXPRON,LEXSEND,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ
- S LEXP=0,LEXENV=$$ENV Q:+LEXENV'>0 S LEXSEND="",LEXPRON="LEXICAL SERVICES UPDATE",LEXPRO=$G(^LEXM(0,"PRO"))
- S:+LEXPRO>0 LEXPRO=$$FMTE^XLFDT(LEXPRO,"1"),LEXP=1
- S LEXACCT=$$U^LEXXFI7 S ZTSAVE("LEXACCT")=""
- S ZTRTN="ALL^LEXXFI",ZTSAVE("LEXSEND")="",ZTSAVE("LEXPOST")=""
- S:$D(LEXCOUNT) ZTSAVE("LEXCOUNT")=""
- I $L($G(LEXPRO)),$L($G(LEXPRON)),+$G(LEXP)>0 S ZTSAVE("LEXPRO")="",ZTSAVE("LEXPRON")=""
- S:$D(LEXPROC)&($O(LEXPROC(0))>0) ZTSAVE("LEXPROC(")=""
- S:$D(LEXLREV) ZTSAVE("LEXLREV")=""
- S:$D(LEXREQP) ZTSAVE("LEXREQP")=""
- S:$L($G(LEXSUBH)) ZTSAVE("LEXSUBH")=""
- S:$D(LEXPTYPE) ZTSAVE("LEXPTYPE")=""
- S:$D(LEXBUILD) ZTSAVE("LEXBUILD")=""
- S:$D(LEXSHORT) ZTSAVE("LEXSHORT")=""
- S:$D(LEXIGHF) ZTSAVE("LEXIGHF")=""
- S:$D(LEXCRE) ZTSAVE("LEXCRE")=""
- S:$D(LEXSTART) ZTSAVE("LEXSTART")=""
- S:$D(LEXID) ZTSAVE("LEXID")=""
- S:$D(LEXRES) ZTSAVE("LEXRES")=""
- S:$D(LEXNOTIM) ZTSAVE("LEXNOTIM")=""
- S:$D(XPDA) ZTSAVE("XPDA")=""
- S (LEXDESC,ZTDESC)="Post-Install File Counts "
- S:$D(LEXSHORT) (LEXDESC,ZTDESC)="Post-Install Summary"
- S ZTDTH=$H,ZTIO="" D ^%ZTLOAD
- I '$D(LEXQUIET) W:+($G(ZTSK))>0 !!," ",LEXDESC,!," Queued Task #",+($G(ZTSK)) W !
- N LEXQUIET
- Q
- MAIL ; Mail global array in message
- N DIFROM,LEXPRI,LEXADR,LEXI,LEXM,LEXSUB,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ
- I '$D(LEXSHORT),+$G(^TMP("LEXCS",$J,0))'>0 G MAILQ
- K ^TMP("LEXMSG",$J)
- S LEXSUB="Lexicon/ICD/CPT Installation"
- S:$L($G(LEXBUILD)) LEXSUB=$G(LEXBUILD)_" Installation"
- S LEXPRI=$$ADR^LEXXFI8
- G:'$L(LEXPRI) MAILQ
- S LEXPRI="G.LEXINS@"_LEXPRI
- S LEXADR=$$GET1^DIQ(200,+($G(DUZ)),.01)
- G:'$L(LEXADR) MAILQ
- S U="^",XMSUB="LEX/ICD/CPT File Checksums - "_$$FMTE^XLFDT($$NOW^XLFDT)
- S:$D(LEXCOUNT) XMSUB="LEX/ICD/CPT File Checksums/Counts - "_$$FMTE^XLFDT($$NOW^XLFDT)
- S:$L($G(LEXBUILD)) XMSUB=$G(LEXBUILD)_" File Checksums"
- I $L($G(LEXBUILD)),$D(LEXCOUNT) S XMSUB=$G(LEXBUILD)_" File Checksums/Counts"
- S:$D(LEXPOST) XMSUB=LEXSUB
- S LEXI=0 F S LEXI=$O(^TMP("LEXKID",$J,LEXI)) Q:+LEXI=0 D
- . S LEXM=+($O(^TMP("LEXMSG",$J," "),-1))+1
- . S ^TMP("LEXMSG",$J,LEXM,0)=$E($G(^TMP("LEXKID",$J,LEXI)),1,79)
- . S ^TMP("LEXMSG",$J,0)=LEXM
- K ^TMP("LEXKID",$J)
- I '$D(LEXSHORT) S LEXI=0 F S LEXI=$O(^TMP("LEXCS",$J,LEXI)) Q:+LEXI=0 D
- . S LEXM=+($O(^TMP("LEXMSG",$J," "),-1))+1
- . S ^TMP("LEXMSG",$J,LEXM,0)=$E($G(^TMP("LEXCS",$J,LEXI)),1,79)
- . S ^TMP("LEXMSG",$J,0)=LEXM
- K ^TMP("LEXCS",$J) G:'$D(^TMP("LEXMSG",$J)) MAILQ G:+($G(^TMP("LEXMSG",$J,0)))'>0 MAILQ
- S XMY(LEXPRI)="",XMY(LEXADR)="",XMTEXT="^TMP(""LEXMSG"",$J,",XMDUZ=.5 D ^XMD
- MAILQ ; Quit Mail
- D KILL
- Q
- ;
- ; Miscellaneous
- HDR ; Header
- N LEXD,LEXP,LEXN,LEXT,LEXU,LEXA,LEXACT,LEXI,LEXF,LEXMUL S LEXF=0 S LEXACT=$G(LEXACCT),LEXA=""
- S:$L($P(LEXACT,"^",1))&($L($P(LEXACT,"^",1))) LEXA=LEXACT
- S:'$L($G(LEXA)) LEXA=$$U^LEXXFI7 S LEXU=$$P^LEXXFI7,LEXD=$$A^LEXXFI7 D TT^LEXXFI8("","Status")
- S LEXT="" S:$L(LEXD) LEXT=" As of: "_LEXD
- I $L(LEXD) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
- S LEXT="",LEXI=$S($L($P(LEXA,"^",1)):"[",1:"")_$P(LEXA,"^",1)_$S($L($P(LEXA,"^",2)):"]",1:"")
- I $L($P(LEXA,",",1))>3,$L($P(LEXA,"^",2)) S LEXI="["_$P(LEXA,",",1)_"]"
- S:$L(LEXI)&($L($P(LEXA,"^",2))) LEXI=LEXI_" "_$P(LEXA,"^",2)
- S LEXT="" S:$L(LEXI) LEXT=" In Account: "_LEXI
- I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
- S LEXN=$P(LEXU,"^",1),LEXP=$P(LEXU,"^",2)
- S LEXT="" S:$L(LEXN) LEXT=" Maint By: "
- S:$L(LEXN) LEXT=LEXT_LEXN S:$L(LEXP)&($L(LEXN)) LEXT=LEXT_" "_LEXP
- I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
- S LEXT="" S:$L($G(LEXBUILD)) LEXT=" Build: "_$G(LEXBUILD)
- I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
- S LEXT="" I $L($G(LEXPRO))&($L($G(LEXPRON))) D
- . S LEXT=" Protocol: "_LEXPRON_" invoked "_LEXPRO
- . I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
- D BL^LEXXFI8
- Q
- TIM ; Time
- Q:$D(LEXPOST) Q:+($G(LEXBEG))'>0 Q:+($G(LEXEND))'>0 Q:'$L($G(LEXELP)) Q:$D(LEXNOTIM)
- D BL^LEXXFI8,TL^LEXXFI8((" Started: "_$TR($$FMTE^XLFDT(LEXBEG),"@"," ")))
- D TL^LEXXFI8((" Finished: "_$TR($$FMTE^XLFDT(LEXEND),"@"," ")))
- D TL^LEXXFI8((" Elapsed: "_LEXELP)),BL^LEXXFI8
- Q
- ENV(X) ; Environment check
- N LEXNM D HOME^%ZIS S U="^",DT=$$DT^XLFDT
- I +($G(DUZ))'>0 W !!," User (DUZ) not defined",! Q 0
- S LEXNM=$$GET1^DIQ(200,+($G(DUZ)),.01)
- I '$L(LEXNM) W !!," Invalid User (DUZ) defined",! Q 0
- S DTIME=$$DTIME^XUP(+($G(DUZ)))
- Q 1
- CLR ; Clear ^TMP("LEXCS",$J)
- K ^TMP("LEXCS",$J) N LEXBUILD,LEXCOUNT,LEXCRE,LEXIGHF,LEXLREV
- N LEXPROC,LEXREQP,LEXRES,LEXSHORT,LEXSTART,XPDA
- Q
- KILL ; Kill all ^TMP("LEX**"
- K ^TMP("LEXCNT",$J),^TMP("LEXCS",$J),^TMP("LEXI",$J)
- K ^TMP("LEXINS",$J),^TMP("LEXMSG",$J),^TMP("LEXKID",$J)
- Q
- ;;
- ;;
- FILES ;;
- ;;;;757
- ;;1;;757.001
- ;;1;;757.01
- ;;;;757.011
- ;;;;757.014
- ;;;;757.02
- ;;;;757.03
- ;;1;;757.04
- ;;1;;757.05
- ;;1;;757.06
- ;;;;757.1
- ;;;;757.11
- ;;;;757.12
- ;;;;757.13
- ;;;;757.14
- ;;1;;757.2
- ;;1;;757.21
- ;;;;757.3
- ;;;;757.31
- ;;1;;757.4
- ;;1;;757.41
- ;;;;80
- ;;;;80.1
- ;;;;80.3
- ;;;;81
- ;;;;81.1
- ;;1;;81.2
- ;;;;81.3
- ;;
- ;;
- ;;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXFI 8441 printed Jan 18, 2025@03:10:58 Page 2
- LEXXFI ;ISL/KER - File Info ;05/23/2017
- +1 ;;2.0;LEXICON UTILITY;**32,46,49,41,59,73,80,103**;Sep 23, 1996;Build 2
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEXM(0) N/A
- +5 ; ^TMP("LEX*",$J) SACC 2.3.2.5.1
- +6 ; ^TMP("LEXCNT") SACC 2.3.2.5.1
- +7 ; ^TMP("LEXCS") SACC 2.3.2.5.1
- +8 ; ^TMP("LEXI") SACC 2.3.2.5.1
- +9 ; ^TMP("LEXINS") SACC 2.3.2.5.1
- +10 ; ^TMP("LEXKID") SACC 2.3.2.5.1
- +11 ; ^TMP("LEXMSG") SACC 2.3.2.5.1
- +12 ;
- +13 ; External References
- +14 ; $$DTIME^XUP ICR 4409
- +15 ; $$DT^XLFDT ICR 10103
- +16 ; $$FMTE^XLFDT ICR 10103
- +17 ; $$GET1^DIQ ICR 2056
- +18 ; $$NOW^XLFDT ICR 10103
- +19 ; HOME^%ZIS ICR 10086
- +20 ; ^%ZISC ICR 10089
- +21 ; ^%ZTLOAD ICR 10063
- +22 ; ^XMD ICR 10070
- +23 ;
- +24 ; Newed by Post-Install LEX20nnP
- +25 ; LEXBUILD Build
- +26 ; LEXCRE Import Global Creation Date
- +27 ; LEXIGHF Import Global Host File
- +28 ; LEXLREV Revision
- +29 ; LEXREQP Required Patches
- +30 ; LEXSHORT Flag for Summary Install Message
- +31 ;
- +32 ; Newed by Post-Install LEXXGI
- +33 ; LEXPROC Protocol Name
- +34 ; LEXRES Install Results
- +35 ; LEXSTART Install Start Time
- +36 ;
- +37 ; Other
- +38 ; XPDA Newed by KIDS during Install
- +39 ; LEXCOUNT Flag Checked $D() and not used
- +40 ;
- +41 QUIT
- +42 ; Checksums/Counts
- EN ; For One or More File(s)
- +1 NEW LEXENV,LEXMET,LEXID
- +2 SET LEXENV=$$ENV
- +3 if +LEXENV'>0
- QUIT
- +4 SET LEXMET=$$MT^LEXXFI7
- +5 IF '$LENGTH(LEXMET)
- WRITE !!," Checksum Files (One or All) not Selected"
- QUIT
- +6 IF $LENGTH($TEXT(@(LEXMET_"^LEXXFI")))>0
- WRITE !
- DO @LEXMET
- +7 QUIT
- ONE ; For ONE file
- +1 KILL ^TMP("LEXCS",$JOB),^TMP("LEXCNT",$JOB),^TMP("LEXI",$JOB),^TMP("LEXMSG",$JOB)
- +2 NEW LEXBEG,LEXELP,LEXEND,LEXFC,LEXFI,LEXLDR,LEXMOD,LEXMUL,LEXNM,LEXTCS
- +3 NEW LEXTND,LEXTT,LEXTXT
- +4 SET LEXBEG=$$TIC^LEXXFI8
- SET LEXMUL=0
- SET LEXMOD=0
- +5 SET LEXFI=$$FI^LEXXFI7
- IF +LEXFI'>0
- WRITE !!," Checksum File not Selected"
- QUIT
- +6 SET LEXLDR=$$LDR^LEXXFI8(LEXFI)
- SET LEXMOD=LEXMOD+($$MOD^LEXXFI8(LEXFI))
- +7 SET LEXNM=$$FN^LEXXFI8(LEXFI)
- SET LEXTT=" "
- +8 WRITE !
- +9 DO ONE^LEXXFI2(LEXFI)
- DO ONE^LEXXFI3(LEXFI)
- DO ONE^LEXXFI5(LEXFI)
- +10 SET LEXEND=$$TIC^LEXXFI8
- SET LEXELP=$$ELAP^LEXXFI8(LEXBEG,LEXEND)
- +11 if LEXELP=""
- SET LEXELP="00:00:00"
- +12 IF +LEXBEG>0
- IF LEXEND>0
- IF $LENGTH(LEXELP)
- DO TIM
- +13 KILL ^TMP("LEXCS",$JOB),^TMP("LEXCNT",$JOB),^TMP("LEXI",$JOB),^TMP("LEXMSG",$JOB)
- +14 QUIT
- ALL ; For ALL files
- +1 KILL ^TMP("LEXCS",$JOB),^TMP("LEXCNT",$JOB),^TMP("LEXI",$JOB),^TMP("LEXMSG",$JOB)
- +2 KILL ^TMP("LEXINS",$JOB),^TMP("LEXKID",$JOB)
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 NEW LEXBEG,LEXELP,LEXEND,LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,LEXID
- +4 SET LEXID="LEXKID"
- SET LEXBEG=$$TIC^LEXXFI8
- SET LEXMUL=1
- SET (LEXTND,LEXTCS,LEXMOD,LEXFC)=0
- +5 if '$DATA(LEXPOST)
- DO HDR
- +6 IF '$DATA(LEXSHORT)
- DO ALL^LEXXFI5
- DO ALL^LEXXFI2
- DO ALL^LEXXFI3
- +7 SET LEXEND=$$TIC^LEXXFI8
- SET LEXELP=$$ELAP^LEXXFI8(LEXBEG,LEXEND)
- +8 if LEXELP=""
- SET LEXELP="00:00:00"
- +9 IF +LEXBEG>0
- IF LEXEND>0
- IF $LENGTH(LEXELP)
- DO TIM
- +10 if $DATA(LEXSEND)!($DATA(LEXPOST))
- DO EN^LEXXII
- KILL ^LEXM(0,"PRO")
- if $DATA(ZTQUEUED)
- DO MAIL
- +11 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +12 NEW LEXI
- SET LEXI=0
- FOR
- SET LEXI=$ORDER(^TMP("LEXKID",$JOB,LEXI))
- if +LEXI=0
- QUIT
- Begin DoDot:2
- +13 WRITE !,$EXTRACT($GET(^TMP("LEXKID",$JOB,LEXI)),1,79)
- End DoDot:2
- End DoDot:1
- +14 DO KILL
- +15 QUIT
- +16 ;
- POST ; Entry Point for Post-Install Message
- +1 NEW LEXPOST
- SET LEXPOST=""
- +2 ;
- SEND ; Send Message
- +1 NEW LEXDESC,LEXENV,LEXP,LEXACCT,LEXPRO,LEXPRON,LEXSEND,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ
- +2 SET LEXP=0
- SET LEXENV=$$ENV
- if +LEXENV'>0
- QUIT
- SET LEXSEND=""
- SET LEXPRON="LEXICAL SERVICES UPDATE"
- SET LEXPRO=$GET(^LEXM(0,"PRO"))
- +3 if +LEXPRO>0
- SET LEXPRO=$$FMTE^XLFDT(LEXPRO,"1")
- SET LEXP=1
- +4 SET LEXACCT=$$U^LEXXFI7
- SET ZTSAVE("LEXACCT")=""
- +5 SET ZTRTN="ALL^LEXXFI"
- SET ZTSAVE("LEXSEND")=""
- SET ZTSAVE("LEXPOST")=""
- +6 if $DATA(LEXCOUNT)
- SET ZTSAVE("LEXCOUNT")=""
- +7 IF $LENGTH($GET(LEXPRO))
- IF $LENGTH($GET(LEXPRON))
- IF +$GET(LEXP)>0
- SET ZTSAVE("LEXPRO")=""
- SET ZTSAVE("LEXPRON")=""
- +8 if $DATA(LEXPROC)&($ORDER(LEXPROC(0))>0)
- SET ZTSAVE("LEXPROC(")=""
- +9 if $DATA(LEXLREV)
- SET ZTSAVE("LEXLREV")=""
- +10 if $DATA(LEXREQP)
- SET ZTSAVE("LEXREQP")=""
- +11 if $LENGTH($GET(LEXSUBH))
- SET ZTSAVE("LEXSUBH")=""
- +12 if $DATA(LEXPTYPE)
- SET ZTSAVE("LEXPTYPE")=""
- +13 if $DATA(LEXBUILD)
- SET ZTSAVE("LEXBUILD")=""
- +14 if $DATA(LEXSHORT)
- SET ZTSAVE("LEXSHORT")=""
- +15 if $DATA(LEXIGHF)
- SET ZTSAVE("LEXIGHF")=""
- +16 if $DATA(LEXCRE)
- SET ZTSAVE("LEXCRE")=""
- +17 if $DATA(LEXSTART)
- SET ZTSAVE("LEXSTART")=""
- +18 if $DATA(LEXID)
- SET ZTSAVE("LEXID")=""
- +19 if $DATA(LEXRES)
- SET ZTSAVE("LEXRES")=""
- +20 if $DATA(LEXNOTIM)
- SET ZTSAVE("LEXNOTIM")=""
- +21 if $DATA(XPDA)
- SET ZTSAVE("XPDA")=""
- +22 SET (LEXDESC,ZTDESC)="Post-Install File Counts "
- +23 if $DATA(LEXSHORT)
- SET (LEXDESC,ZTDESC)="Post-Install Summary"
- +24 SET ZTDTH=$HOROLOG
- SET ZTIO=""
- DO ^%ZTLOAD
- +25 IF '$DATA(LEXQUIET)
- if +($GET(ZTSK))>0
- WRITE !!," ",LEXDESC,!," Queued Task #",+($GET(ZTSK))
- WRITE !
- +26 NEW LEXQUIET
- +27 QUIT
- MAIL ; Mail global array in message
- +1 NEW DIFROM,LEXPRI,LEXADR,LEXI,LEXM,LEXSUB,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ
- +2 IF '$DATA(LEXSHORT)
- IF +$GET(^TMP("LEXCS",$JOB,0))'>0
- GOTO MAILQ
- +3 KILL ^TMP("LEXMSG",$JOB)
- +4 SET LEXSUB="Lexicon/ICD/CPT Installation"
- +5 if $LENGTH($GET(LEXBUILD))
- SET LEXSUB=$GET(LEXBUILD)_" Installation"
- +6 SET LEXPRI=$$ADR^LEXXFI8
- +7 if '$LENGTH(LEXPRI)
- GOTO MAILQ
- +8 SET LEXPRI="G.LEXINS@"_LEXPRI
- +9 SET LEXADR=$$GET1^DIQ(200,+($GET(DUZ)),.01)
- +10 if '$LENGTH(LEXADR)
- GOTO MAILQ
- +11 SET U="^"
- SET XMSUB="LEX/ICD/CPT File Checksums - "_$$FMTE^XLFDT($$NOW^XLFDT)
- +12 if $DATA(LEXCOUNT)
- SET XMSUB="LEX/ICD/CPT File Checksums/Counts - "_$$FMTE^XLFDT($$NOW^XLFDT)
- +13 if $LENGTH($GET(LEXBUILD))
- SET XMSUB=$GET(LEXBUILD)_" File Checksums"
- +14 IF $LENGTH($GET(LEXBUILD))
- IF $DATA(LEXCOUNT)
- SET XMSUB=$GET(LEXBUILD)_" File Checksums/Counts"
- +15 if $DATA(LEXPOST)
- SET XMSUB=LEXSUB
- +16 SET LEXI=0
- FOR
- SET LEXI=$ORDER(^TMP("LEXKID",$JOB,LEXI))
- if +LEXI=0
- QUIT
- Begin DoDot:1
- +17 SET LEXM=+($ORDER(^TMP("LEXMSG",$JOB," "),-1))+1
- +18 SET ^TMP("LEXMSG",$JOB,LEXM,0)=$EXTRACT($GET(^TMP("LEXKID",$JOB,LEXI)),1,79)
- +19 SET ^TMP("LEXMSG",$JOB,0)=LEXM
- End DoDot:1
- +20 KILL ^TMP("LEXKID",$JOB)
- +21 IF '$DATA(LEXSHORT)
- SET LEXI=0
- FOR
- SET LEXI=$ORDER(^TMP("LEXCS",$JOB,LEXI))
- if +LEXI=0
- QUIT
- Begin DoDot:1
- +22 SET LEXM=+($ORDER(^TMP("LEXMSG",$JOB," "),-1))+1
- +23 SET ^TMP("LEXMSG",$JOB,LEXM,0)=$EXTRACT($GET(^TMP("LEXCS",$JOB,LEXI)),1,79)
- +24 SET ^TMP("LEXMSG",$JOB,0)=LEXM
- End DoDot:1
- +25 KILL ^TMP("LEXCS",$JOB)
- if '$DATA(^TMP("LEXMSG",$JOB))
- GOTO MAILQ
- if +($GET(^TMP("LEXMSG",$JOB,0)))'>0
- GOTO MAILQ
- +26 SET XMY(LEXPRI)=""
- SET XMY(LEXADR)=""
- SET XMTEXT="^TMP(""LEXMSG"",$J,"
- SET XMDUZ=.5
- DO ^XMD
- MAILQ ; Quit Mail
- +1 DO KILL
- +2 QUIT
- +3 ;
- +4 ; Miscellaneous
- HDR ; Header
- +1 NEW LEXD,LEXP,LEXN,LEXT,LEXU,LEXA,LEXACT,LEXI,LEXF,LEXMUL
- SET LEXF=0
- SET LEXACT=$GET(LEXACCT)
- SET LEXA=""
- +2 if $LENGTH($PIECE(LEXACT,"^",1))&($LENGTH($PIECE(LEXACT,"^",1)))
- SET LEXA=LEXACT
- +3 if '$LENGTH($GET(LEXA))
- SET LEXA=$$U^LEXXFI7
- SET LEXU=$$P^LEXXFI7
- SET LEXD=$$A^LEXXFI7
- DO TT^LEXXFI8("","Status")
- +4 SET LEXT=""
- if $LENGTH(LEXD)
- SET LEXT=" As of: "_LEXD
- +5 IF $LENGTH(LEXD)
- if +LEXF'>0
- DO BL^LEXXFI8
- DO TL^LEXXFI8(LEXT)
- SET LEXF=1
- +6 SET LEXT=""
- SET LEXI=$SELECT($LENGTH($PIECE(LEXA,"^",1)):"[",1:"")_$PIECE(LEXA,"^",1)_$SELECT($LENGTH($PIECE(LEXA,"^",2)):"]",1:"")
- +7 IF $LENGTH($PIECE(LEXA,",",1))>3
- IF $LENGTH($PIECE(LEXA,"^",2))
- SET LEXI="["_$PIECE(LEXA,",",1)_"]"
- +8 if $LENGTH(LEXI)&($LENGTH($PIECE(LEXA,"^",2)))
- SET LEXI=LEXI_" "_$PIECE(LEXA,"^",2)
- +9 SET LEXT=""
- if $LENGTH(LEXI)
- SET LEXT=" In Account: "_LEXI
- +10 IF $LENGTH(LEXT)
- if +LEXF'>0
- DO BL^LEXXFI8
- DO TL^LEXXFI8(LEXT)
- SET LEXF=1
- +11 SET LEXN=$PIECE(LEXU,"^",1)
- SET LEXP=$PIECE(LEXU,"^",2)
- +12 SET LEXT=""
- if $LENGTH(LEXN)
- SET LEXT=" Maint By: "
- +13 if $LENGTH(LEXN)
- SET LEXT=LEXT_LEXN
- if $LENGTH(LEXP)&($LENGTH(LEXN))
- SET LEXT=LEXT_" "_LEXP
- +14 IF $LENGTH(LEXT)
- if +LEXF'>0
- DO BL^LEXXFI8
- DO TL^LEXXFI8(LEXT)
- SET LEXF=1
- +15 SET LEXT=""
- if $LENGTH($GET(LEXBUILD))
- SET LEXT=" Build: "_$GET(LEXBUILD)
- +16 IF $LENGTH(LEXT)
- if +LEXF'>0
- DO BL^LEXXFI8
- DO TL^LEXXFI8(LEXT)
- SET LEXF=1
- +17 SET LEXT=""
- IF $LENGTH($GET(LEXPRO))&($LENGTH($GET(LEXPRON)))
- Begin DoDot:1
- +18 SET LEXT=" Protocol: "_LEXPRON_" invoked "_LEXPRO
- +19 IF $LENGTH(LEXT)
- if +LEXF'>0
- DO BL^LEXXFI8
- DO TL^LEXXFI8(LEXT)
- SET LEXF=1
- End DoDot:1
- +20 DO BL^LEXXFI8
- +21 QUIT
- TIM ; Time
- +1 if $DATA(LEXPOST)
- QUIT
- if +($GET(LEXBEG))'>0
- QUIT
- if +($GET(LEXEND))'>0
- QUIT
- if '$LENGTH($GET(LEXELP))
- QUIT
- if $DATA(LEXNOTIM)
- QUIT
- +2 DO BL^LEXXFI8
- DO TL^LEXXFI8((" Started: "_$TRANSLATE($$FMTE^XLFDT(LEXBEG),"@"," ")))
- +3 DO TL^LEXXFI8((" Finished: "_$TRANSLATE($$FMTE^XLFDT(LEXEND),"@"," ")))
- +4 DO TL^LEXXFI8((" Elapsed: "_LEXELP))
- DO BL^LEXXFI8
- +5 QUIT
- ENV(X) ; Environment check
- +1 NEW LEXNM
- DO HOME^%ZIS
- SET U="^"
- SET DT=$$DT^XLFDT
- +2 IF +($GET(DUZ))'>0
- WRITE !!," User (DUZ) not defined",!
- QUIT 0
- +3 SET LEXNM=$$GET1^DIQ(200,+($GET(DUZ)),.01)
- +4 IF '$LENGTH(LEXNM)
- WRITE !!," Invalid User (DUZ) defined",!
- QUIT 0
- +5 SET DTIME=$$DTIME^XUP(+($GET(DUZ)))
- +6 QUIT 1
- CLR ; Clear ^TMP("LEXCS",$J)
- +1 KILL ^TMP("LEXCS",$JOB)
- NEW LEXBUILD,LEXCOUNT,LEXCRE,LEXIGHF,LEXLREV
- +2 NEW LEXPROC,LEXREQP,LEXRES,LEXSHORT,LEXSTART,XPDA
- +3 QUIT
- KILL ; Kill all ^TMP("LEX**"
- +1 KILL ^TMP("LEXCNT",$JOB),^TMP("LEXCS",$JOB),^TMP("LEXI",$JOB)
- +2 KILL ^TMP("LEXINS",$JOB),^TMP("LEXMSG",$JOB),^TMP("LEXKID",$JOB)
- +3 QUIT
- +4 ;;
- +5 ;;
- FILES ;;
- +1 ;;;;757
- +2 ;;1;;757.001
- +3 ;;1;;757.01
- +4 ;;;;757.011
- +5 ;;;;757.014
- +6 ;;;;757.02
- +7 ;;;;757.03
- +8 ;;1;;757.04
- +9 ;;1;;757.05
- +10 ;;1;;757.06
- +11 ;;;;757.1
- +12 ;;;;757.11
- +13 ;;;;757.12
- +14 ;;;;757.13
- +15 ;;;;757.14
- +16 ;;1;;757.2
- +17 ;;1;;757.21
- +18 ;;;;757.3
- +19 ;;;;757.31
- +20 ;;1;;757.4
- +21 ;;1;;757.41
- +22 ;;;;80
- +23 ;;;;80.1
- +24 ;;;;80.3
- +25 ;;;;81
- +26 ;;;;81.1
- +27 ;;1;;81.2
- +28 ;;;;81.3
- +29 ;;
- +30 ;;
- +31 ;;
- +32 QUIT