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 Dec 13, 2024@02:10:03 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
