LEXXII ;ISL/KER - Lexicon Status (Install Info) ;05/23/2017
;;2.0;LEXICON UTILITY;**32,46,49,50,41,59,73,80,103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^%ZOSF("UCI") ICR 10096
; ^LEXM(0) N/A
; ^TMP("LEX*",$J) SACC 2.3.2.5.1
; ^TMP("LEX*",$J) SACC 2.3.2.5.1
; ^VA(200) ICR 10060
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$GET1^DIQ ICR 2056
; $$NOW^XLFDT ICR 10103
; FIND^DIC ICR 2051
; GETS^DIQ ICR 2056
; $$PROD^XUPROD ICR 4440
;
; Variables NEWed or KILLed Elsewhere
; LEXACCT NEWed by LEXXFI sending message
; LEXID NEWed by LEXXFI sending message
; LEXCRE NEWed by LEXXGI loading data
; LEXIGHF NEWed by Post Install routine LEX20nnP
; XPDA NEWed by KIDS during Install
;
EN ; Main Entry
N LEXSUB S LEXSUB=$G(LEXID) S:LEXSUB="" LEXSUB="LEXXII" K ^TMP(LEXSUB,$J) D II
Q
;
II ; Install Information
N LEXT,LEXA,LEXACT,LEXB,LEXD,LEXE,LEXL,LEXU,LEXN,LEXP,LEXPROF,LEXDA H 2
S LEXA="",LEXACT=$G(LEXACCT),LEXPRO=$G(LEXPRO),LEXPRON=$G(LEXPRON)
S:'$L(LEXPRON) LEXPRON="LEXICAL SERVICES UPDATE" S:'$L(LEXPRO) LEXPRO=$G(^LEXM(0,"PRO")) S:+LEXPRO>0 LEXPRO=$$ED(LEXPRO)
I $L($G(LEXSUBH)) D
. N LEXL S LEXT=$G(LEXSUBH),$P(LEXL,"=",$L(LEXT))="=" D TL(LEXT),TL(LEXL),BL
I '$L($G(LEXSUBH)) D
. S LEXT="Lexicon/ICD/CPT Installation" D TL(LEXT)
. S LEXT="============================" D TL(LEXT),BL
S LEXD=$$ASOF,LEXA=$$UCI,LEXU=$$USR,LEXN=$P(LEXU,"^",1)
S:$L($P(LEXACT,"^",1))&($L($P(LEXACT,"^",1))) LEXA=LEXACT
S LEXP=$P(LEXU,"^",2),LEXN=$$PM^LEXXFI7(LEXN)
S:$L(LEXD) LEXT=" As of: "_LEXD
D:$L(LEXD) TL(LEXT)
S LEXT="" S:$L(LEXA) LEXT=" In Account: "_$S($L($P(LEXA,"^",1)):"[",1:"")_$P(LEXA,"^",1)_$S($L($P(LEXA,"^",2)):"]",1:"")
S:$L(LEXT)&($L($P(LEXA,"^",2))) LEXT=LEXT_" "_$P(LEXA,"^",2)
D:$L(LEXA) TL(LEXT)
S LEXT="" S:$L(LEXU) LEXT=" Maint By: "
S:$L(LEXN) LEXT=LEXT_LEXN
S:$L(LEXP)&($L(LEXN)) LEXT=LEXT_" "_LEXP
D:$L(LEXT)&(LEXT'["UNKNOWN") TL(LEXT)
S LEXT="" S:$L($G(LEXBUILD)) LEXT=" Build: "_$G(LEXBUILD)
D:$L(LEXT) TL(LEXT)
S LEXT="" S:$L($G(LEXIGHF)) LEXT=" Host File: "_$G(LEXIGHF)
S:$L(LEXT)&($L($G(LEXCRE)))&($P($G(LEXCRE),".",1)?7N) LEXT=LEXT_" (Created "_$$ED($G(LEXCRE))_")"
S:'$L(LEXT)&($L($G(LEXCRE)))&($P($G(LEXCRE),".",1)?7N) LEXT=" Created: "_$$ED($G(LEXCRE))
D:$L(LEXT) TL(LEXT)
S LEXT="" I $O(LEXPROC(" "),-1)'>1,$L($G(LEXPRO))&($L($G(LEXPRON))),$O(LEXPROC(" "),-1)'>1 D
. S LEXT=" Protocol: "_LEXPRON D BL,TL(LEXT)
. S LEXT=" Invoked: "_LEXPRO D TL(LEXT)
. K LEXPRO,LEXPRON,^LEXM(0,"PRO")
I $O(LEXPROC(" "),-1)>1 D
. N LEXT,LEXI,LEXC,LEXT S LEXT=$$TRIM($G(LEXPROC(1))) Q:'$L(LEXT) D BL,TL((" "_LEXT))
. S LEXC=0,LEXI=1 F S LEXI=$O(LEXPROC(LEXI)) Q:+LEXI'>0 D
. . N LEXT S LEXT=$$TRIM($TR($G(LEXPROC(LEXI)),"'","")) Q:'$L(LEXT) S LEXC=LEXC+1 D TL((" "_LEXT))
S LEXB=$$SS($G(LEXBUILD)),LEXE=$P(LEXB,"^",2),LEXL=$P(LEXB,"^",3),LEXB=$P(LEXB,"^",1)
I '$D(LEXNOTIM),$P(LEXB,".",1)?7N!($P(LEXB,".",2)?7N)!($P(LEXB,".",3)[":") D
. D BL
. I $P(LEXB,".",1)?7N D
. . S LEXT="" S LEXT=" Started: "_$$ED($G(LEXB)) D TL(LEXT)
. I $P(LEXE,".",1)?7N D
. . S LEXT="" S LEXT=" Finished: "_$$ED($G(LEXE)) D TL(LEXT)
. I $L(LEXL) D
. . S LEXT="" S LEXT=" Elapsed: "_$$ED($G(LEXL)) D TL(LEXT)
I $L($G(LEXRES)) D
. S LEXT="" S LEXT=" Data: "_$G(LEXRES) D BL,TL(LEXT)
D BL
Q
;
; Miscellaneous
UCI(X) ; UCI where Lexicon is installed
N LEXU,LEXP,LEXT,Y X ^%ZOSF("UCI") S LEXU=Y,LEXP=""
S LEXP=$S($$PROD^XUPROD(1):" (Production)",1:" (Test)")
S:LEXU[","&($L($P(LEXU,",",1))>3) LEXU=$P(LEXU,",",1)
S X="",$P(X,"^",1)=LEXU,$P(X,"^",2)=LEXP
Q X
USR(LEX) ; User/Person
N LEXDUZ,LEXPH,LEXNM
S LEX=+($G(DUZ)),LEXNM=$$GET1^DIQ(200,+LEX,.01) Q:'$L(LEXNM) "UNKNOWN^"
S LEXDUZ=LEX S LEXPH=$$GET1^DIQ(200,+LEXDUZ,.132) S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXDUZ,.131)
S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXDUZ,.133) S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXDUZ,.134)
S LEXDUZ=$$GET1^DIQ(200,+LEX,.01),LEX=LEXDUZ_"^"_LEXPH Q LEX
SS(LEX) ; Start/Stop Times
N LEXDA,LEXOUT,LEXIENS,LEXB,LEXBUILD,LEXB,LEXE,LEXL
S LEXBUILD=$G(LEX),LEXD=0 S:$L(LEXBUILD) LEXD=$$DDA(LEXBUILD)
S LEXDA=+($G(XPDA))
I +LEXDA>0 D
. S LEXIENS=LEXDA_"," D GETS^DIQ(9.7,LEXIENS,"11;17","I","LEXOUT")
. S LEXL=0,LEXB=$G(LEXOUT(9.7,LEXIENS,11,"I"))
. S:$L($G(LEXSTART))&($P($G(LEXSTART),".",1)?7N) LEXB=$G(LEXSTART)
. S LEXE=$$NOW^XLFDT S:+LEXB>0&(+LEXE>0) LEXL=$$EP(LEXB,LEXE)
. S LEX=LEXB_"^"_LEXE S:$L(LEXL) $P(LEX,"^",3)=LEXL
I +LEXDA=0 D
. S LEX="" S LEXDA=+($G(LEXD)) S LEXL="",LEXB=$P($G(LEXD),"^",2)
. S:$L($G(LEXSTART))&($P($G(LEXSTART),".",1)?7N) LEXB=$G(LEXSTART)
. S LEXE=$$NOW^XLFDT S:+LEXB>0&(+LEXE>0) LEXL=$$EP(LEXB,LEXE)
. S LEX=LEXB_"^"_LEXE S:$L(LEXL) $P(LEX,"^",3)=LEXL
Q LEX
DDA(LEX) ; Get Default DA of Build LEX
N LEXB,LEXE,LEXOUT,LEXMSG,LEXI S LEXB=$G(LEX) Q:'$L(LEXB) ""
D FIND^DIC(9.7,,"11I;17I","BP",LEXB,,"B",,,"LEXOUT","LEXMSG")
S LEXI=+($O(LEXOUT("DILIST"," "),-1))
S LEXB=$G(LEXOUT("DILIST",+LEXI,0))
S LEXI=$P(LEXB,"^",1),LEXE=$P(LEXB,"^",4),LEXB=$P(LEXB,"^",3)
Q:+($G(LEXI))'>0 "" Q:+($G(LEXB))'>0 "" S:+LEXE'>0 LEXE=$$NOW^XLFDT
S LEX=LEXI_"^"_LEXB_"^"_LEXE
Q LEX
ASOF(LEX) ; As of date/time
S X=$$ED($$NOW^XLFDT) Q X
ED(LEX) ; External Date MM/DD/YYYY TT:TT
S LEX=$$FMTE^XLFDT($G(LEX),"1Z")
S:LEX["@" LEX=$P(LEX,"@",1)_" "_$P(LEX,"@",2,4000) Q LEX
Q LEX
EP(X,Y) ; Elapsed Time (Begin, End)
N LEXTIM,LEXBEG,LEXEND
S LEXBEG=$G(X),LEXEND=$G(Y) Q:+LEXBEG'>0 "" Q:+LEXEND'>0 ""
S LEXTIM=$$FMDIFF^XLFDT(LEXEND,LEXBEG,2) Q:+LEXTIM'>0 "00:00:00"
S LEXTIM=$$TIM(LEXTIM)
Q LEXTIM
TIM(X) ; Format Time Elapsed
N LEXD,LEXH,LEXM,LEXS,LEXT,LEXV S X=+($G(X)) Q:X'>0 "00:00:00"
S LEXD=X\86400 S LEXV=LEXD*86400 S:+LEXV>0&(LEXV<X) X=X-LEXV
S LEXH=X\3600 S LEXV=LEXH*3600 S:+LEXV>0&(LEXV<X) X=X-LEXV
S:$L(LEXH)<2 LEXH="0"_LEXH S:$L(LEXH)<2 LEXH="0"_LEXH
S LEXM=X\60 S LEXV=LEXM*60 S:+LEXV>0&(LEXV<X) X=X-LEXV
S:$L(LEXM)<2 LEXM="0"_LEXM S:$L(LEXM)<2 LEXM="0"_LEXM
S LEXS=X S:$L(LEXS)<2 LEXS="0"_LEXS S:$L(LEXS)<2 LEXS="0"_LEXS
S LEXT="" S:+LEXD>0 LEXT=+LEXD_" day"_$S(+LEXD>1:"s",1:"")_" "
S LEXT=LEXT_LEXH_":"_LEXM_":"_LEXS,X=LEXT
Q X
BL ; Blank Line
D TL("") Q
TL(LEXX) ; Text Line
S LEXSUB=$G(LEXSUB) S:'$L(LEXSUB) LEXSUB="LEXXII"
I '$D(^TMP(LEXSUB,$J,1)) S ^TMP(LEXSUB,$J,1)=" ",^TMP(LEXSUB,$J,0)=1
N LEXNX S LEXNX=$O(^TMP(LEXSUB,$J," "),-1),LEXNX=LEXNX+1
S ^TMP(LEXSUB,$J,LEXNX)=" "_$G(LEXX),^TMP(LEXSUB,$J,0)=LEXNX
Q
ST ; Show Temp Array
S LEXSUB=$G(LEXSUB) S:'$L(LEXSUB) LEXSUB="LEXXII"
N LEXN,LEXC S LEXN="^TMP("""_LEXSUB_""","_$J_")",LEXC="^TMP("""_LEXSUB_""","_$J_","
F S LEXN=$Q(@LEXN) Q:LEXN=""!(LEXN'[LEXC) D
. Q:LEXN[",0)" W !,@LEXN
Q
TRIM(X) ; Trim Spaces
S X=$G(X) Q:X="" X F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXII 7248 printed Dec 13, 2024@02:10:20 Page 2
LEXXII ;ISL/KER - Lexicon Status (Install Info) ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**32,46,49,50,41,59,73,80,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^%ZOSF("UCI") ICR 10096
+5 ; ^LEXM(0) N/A
+6 ; ^TMP("LEX*",$J) SACC 2.3.2.5.1
+7 ; ^TMP("LEX*",$J) SACC 2.3.2.5.1
+8 ; ^VA(200) ICR 10060
+9 ;
+10 ; External References
+11 ; $$FMDIFF^XLFDT ICR 10103
+12 ; $$FMTE^XLFDT ICR 10103
+13 ; $$GET1^DIQ ICR 2056
+14 ; $$NOW^XLFDT ICR 10103
+15 ; FIND^DIC ICR 2051
+16 ; GETS^DIQ ICR 2056
+17 ; $$PROD^XUPROD ICR 4440
+18 ;
+19 ; Variables NEWed or KILLed Elsewhere
+20 ; LEXACCT NEWed by LEXXFI sending message
+21 ; LEXID NEWed by LEXXFI sending message
+22 ; LEXCRE NEWed by LEXXGI loading data
+23 ; LEXIGHF NEWed by Post Install routine LEX20nnP
+24 ; XPDA NEWed by KIDS during Install
+25 ;
EN ; Main Entry
+1 NEW LEXSUB
SET LEXSUB=$GET(LEXID)
if LEXSUB=""
SET LEXSUB="LEXXII"
KILL ^TMP(LEXSUB,$JOB)
DO II
+2 QUIT
+3 ;
II ; Install Information
+1 NEW LEXT,LEXA,LEXACT,LEXB,LEXD,LEXE,LEXL,LEXU,LEXN,LEXP,LEXPROF,LEXDA
HANG 2
+2 SET LEXA=""
SET LEXACT=$GET(LEXACCT)
SET LEXPRO=$GET(LEXPRO)
SET LEXPRON=$GET(LEXPRON)
+3 if '$LENGTH(LEXPRON)
SET LEXPRON="LEXICAL SERVICES UPDATE"
if '$LENGTH(LEXPRO)
SET LEXPRO=$GET(^LEXM(0,"PRO"))
if +LEXPRO>0
SET LEXPRO=$$ED(LEXPRO)
+4 IF $LENGTH($GET(LEXSUBH))
Begin DoDot:1
+5 NEW LEXL
SET LEXT=$GET(LEXSUBH)
SET $PIECE(LEXL,"=",$LENGTH(LEXT))="="
DO TL(LEXT)
DO TL(LEXL)
DO BL
End DoDot:1
+6 IF '$LENGTH($GET(LEXSUBH))
Begin DoDot:1
+7 SET LEXT="Lexicon/ICD/CPT Installation"
DO TL(LEXT)
+8 SET LEXT="============================"
DO TL(LEXT)
DO BL
End DoDot:1
+9 SET LEXD=$$ASOF
SET LEXA=$$UCI
SET LEXU=$$USR
SET LEXN=$PIECE(LEXU,"^",1)
+10 if $LENGTH($PIECE(LEXACT,"^",1))&($LENGTH($PIECE(LEXACT,"^",1)))
SET LEXA=LEXACT
+11 SET LEXP=$PIECE(LEXU,"^",2)
SET LEXN=$$PM^LEXXFI7(LEXN)
+12 if $LENGTH(LEXD)
SET LEXT=" As of: "_LEXD
+13 if $LENGTH(LEXD)
DO TL(LEXT)
+14 SET LEXT=""
if $LENGTH(LEXA)
SET LEXT=" In Account: "_$SELECT($LENGTH($PIECE(LEXA,"^",1)):"[",1:"")_$PIECE(LEXA,"^",1)_$SELECT($LENGTH($PIECE(LEXA,"^",2)):"]",1:"")
+15 if $LENGTH(LEXT)&($LENGTH($PIECE(LEXA,"^",2)))
SET LEXT=LEXT_" "_$PIECE(LEXA,"^",2)
+16 if $LENGTH(LEXA)
DO TL(LEXT)
+17 SET LEXT=""
if $LENGTH(LEXU)
SET LEXT=" Maint By: "
+18 if $LENGTH(LEXN)
SET LEXT=LEXT_LEXN
+19 if $LENGTH(LEXP)&($LENGTH(LEXN))
SET LEXT=LEXT_" "_LEXP
+20 if $LENGTH(LEXT)&(LEXT'["UNKNOWN")
DO TL(LEXT)
+21 SET LEXT=""
if $LENGTH($GET(LEXBUILD))
SET LEXT=" Build: "_$GET(LEXBUILD)
+22 if $LENGTH(LEXT)
DO TL(LEXT)
+23 SET LEXT=""
if $LENGTH($GET(LEXIGHF))
SET LEXT=" Host File: "_$GET(LEXIGHF)
+24 if $LENGTH(LEXT)&($LENGTH($GET(LEXCRE)))&($PIECE($GET(LEXCRE),".",1)?7N)
SET LEXT=LEXT_" (Created "_$$ED($GET(LEXCRE))_")"
+25 if '$LENGTH(LEXT)&($LENGTH($GET(LEXCRE)))&($PIECE($GET(LEXCRE),".",1)?7N)
SET LEXT=" Created: "_$$ED($GET(LEXCRE))
+26 if $LENGTH(LEXT)
DO TL(LEXT)
+27 SET LEXT=""
IF $ORDER(LEXPROC(" "),-1)'>1
IF $LENGTH($GET(LEXPRO))&($LENGTH($GET(LEXPRON)))
IF $ORDER(LEXPROC(" "),-1)'>1
Begin DoDot:1
+28 SET LEXT=" Protocol: "_LEXPRON
DO BL
DO TL(LEXT)
+29 SET LEXT=" Invoked: "_LEXPRO
DO TL(LEXT)
+30 KILL LEXPRO,LEXPRON,^LEXM(0,"PRO")
End DoDot:1
+31 IF $ORDER(LEXPROC(" "),-1)>1
Begin DoDot:1
+32 NEW LEXT,LEXI,LEXC,LEXT
SET LEXT=$$TRIM($GET(LEXPROC(1)))
if '$LENGTH(LEXT)
QUIT
DO BL
DO TL((" "_LEXT))
+33 SET LEXC=0
SET LEXI=1
FOR
SET LEXI=$ORDER(LEXPROC(LEXI))
if +LEXI'>0
QUIT
Begin DoDot:2
+34 NEW LEXT
SET LEXT=$$TRIM($TRANSLATE($GET(LEXPROC(LEXI)),"'",""))
if '$LENGTH(LEXT)
QUIT
SET LEXC=LEXC+1
DO TL((" "_LEXT))
End DoDot:2
End DoDot:1
+35 SET LEXB=$$SS($GET(LEXBUILD))
SET LEXE=$PIECE(LEXB,"^",2)
SET LEXL=$PIECE(LEXB,"^",3)
SET LEXB=$PIECE(LEXB,"^",1)
+36 IF '$DATA(LEXNOTIM)
IF $PIECE(LEXB,".",1)?7N!($PIECE(LEXB,".",2)?7N)!($PIECE(LEXB,".",3)[":")
Begin DoDot:1
+37 DO BL
+38 IF $PIECE(LEXB,".",1)?7N
Begin DoDot:2
+39 SET LEXT=""
SET LEXT=" Started: "_$$ED($GET(LEXB))
DO TL(LEXT)
End DoDot:2
+40 IF $PIECE(LEXE,".",1)?7N
Begin DoDot:2
+41 SET LEXT=""
SET LEXT=" Finished: "_$$ED($GET(LEXE))
DO TL(LEXT)
End DoDot:2
+42 IF $LENGTH(LEXL)
Begin DoDot:2
+43 SET LEXT=""
SET LEXT=" Elapsed: "_$$ED($GET(LEXL))
DO TL(LEXT)
End DoDot:2
End DoDot:1
+44 IF $LENGTH($GET(LEXRES))
Begin DoDot:1
+45 SET LEXT=""
SET LEXT=" Data: "_$GET(LEXRES)
DO BL
DO TL(LEXT)
End DoDot:1
+46 DO BL
+47 QUIT
+48 ;
+49 ; Miscellaneous
UCI(X) ; UCI where Lexicon is installed
+1 NEW LEXU,LEXP,LEXT,Y
XECUTE ^%ZOSF("UCI")
SET LEXU=Y
SET LEXP=""
+2 SET LEXP=$SELECT($$PROD^XUPROD(1):" (Production)",1:" (Test)")
+3 if LEXU[","&($LENGTH($PIECE(LEXU,",",1))>3)
SET LEXU=$PIECE(LEXU,",",1)
+4 SET X=""
SET $PIECE(X,"^",1)=LEXU
SET $PIECE(X,"^",2)=LEXP
+5 QUIT X
USR(LEX) ; User/Person
+1 NEW LEXDUZ,LEXPH,LEXNM
+2 SET LEX=+($GET(DUZ))
SET LEXNM=$$GET1^DIQ(200,+LEX,.01)
if '$LENGTH(LEXNM)
QUIT "UNKNOWN^"
+3 SET LEXDUZ=LEX
SET LEXPH=$$GET1^DIQ(200,+LEXDUZ,.132)
if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+LEXDUZ,.131)
+4 if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+LEXDUZ,.133)
if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+LEXDUZ,.134)
+5 SET LEXDUZ=$$GET1^DIQ(200,+LEX,.01)
SET LEX=LEXDUZ_"^"_LEXPH
QUIT LEX
SS(LEX) ; Start/Stop Times
+1 NEW LEXDA,LEXOUT,LEXIENS,LEXB,LEXBUILD,LEXB,LEXE,LEXL
+2 SET LEXBUILD=$GET(LEX)
SET LEXD=0
if $LENGTH(LEXBUILD)
SET LEXD=$$DDA(LEXBUILD)
+3 SET LEXDA=+($GET(XPDA))
+4 IF +LEXDA>0
Begin DoDot:1
+5 SET LEXIENS=LEXDA_","
DO GETS^DIQ(9.7,LEXIENS,"11;17","I","LEXOUT")
+6 SET LEXL=0
SET LEXB=$GET(LEXOUT(9.7,LEXIENS,11,"I"))
+7 if $LENGTH($GET(LEXSTART))&($PIECE($GET(LEXSTART),".",1)?7N)
SET LEXB=$GET(LEXSTART)
+8 SET LEXE=$$NOW^XLFDT
if +LEXB>0&(+LEXE>0)
SET LEXL=$$EP(LEXB,LEXE)
+9 SET LEX=LEXB_"^"_LEXE
if $LENGTH(LEXL)
SET $PIECE(LEX,"^",3)=LEXL
End DoDot:1
+10 IF +LEXDA=0
Begin DoDot:1
+11 SET LEX=""
SET LEXDA=+($GET(LEXD))
SET LEXL=""
SET LEXB=$PIECE($GET(LEXD),"^",2)
+12 if $LENGTH($GET(LEXSTART))&($PIECE($GET(LEXSTART),".",1)?7N)
SET LEXB=$GET(LEXSTART)
+13 SET LEXE=$$NOW^XLFDT
if +LEXB>0&(+LEXE>0)
SET LEXL=$$EP(LEXB,LEXE)
+14 SET LEX=LEXB_"^"_LEXE
if $LENGTH(LEXL)
SET $PIECE(LEX,"^",3)=LEXL
End DoDot:1
+15 QUIT LEX
DDA(LEX) ; Get Default DA of Build LEX
+1 NEW LEXB,LEXE,LEXOUT,LEXMSG,LEXI
SET LEXB=$GET(LEX)
if '$LENGTH(LEXB)
QUIT ""
+2 DO FIND^DIC(9.7,,"11I;17I","BP",LEXB,,"B",,,"LEXOUT","LEXMSG")
+3 SET LEXI=+($ORDER(LEXOUT("DILIST"," "),-1))
+4 SET LEXB=$GET(LEXOUT("DILIST",+LEXI,0))
+5 SET LEXI=$PIECE(LEXB,"^",1)
SET LEXE=$PIECE(LEXB,"^",4)
SET LEXB=$PIECE(LEXB,"^",3)
+6 if +($GET(LEXI))'>0
QUIT ""
if +($GET(LEXB))'>0
QUIT ""
if +LEXE'>0
SET LEXE=$$NOW^XLFDT
+7 SET LEX=LEXI_"^"_LEXB_"^"_LEXE
+8 QUIT LEX
ASOF(LEX) ; As of date/time
+1 SET X=$$ED($$NOW^XLFDT)
QUIT X
ED(LEX) ; External Date MM/DD/YYYY TT:TT
+1 SET LEX=$$FMTE^XLFDT($GET(LEX),"1Z")
+2 if LEX["@"
SET LEX=$PIECE(LEX,"@",1)_" "_$PIECE(LEX,"@",2,4000)
QUIT LEX
+3 QUIT LEX
EP(X,Y) ; Elapsed Time (Begin, End)
+1 NEW LEXTIM,LEXBEG,LEXEND
+2 SET LEXBEG=$GET(X)
SET LEXEND=$GET(Y)
if +LEXBEG'>0
QUIT ""
if +LEXEND'>0
QUIT ""
+3 SET LEXTIM=$$FMDIFF^XLFDT(LEXEND,LEXBEG,2)
if +LEXTIM'>0
QUIT "00:00:00"
+4 SET LEXTIM=$$TIM(LEXTIM)
+5 QUIT LEXTIM
TIM(X) ; Format Time Elapsed
+1 NEW LEXD,LEXH,LEXM,LEXS,LEXT,LEXV
SET X=+($GET(X))
if X'>0
QUIT "00:00:00"
+2 SET LEXD=X\86400
SET LEXV=LEXD*86400
if +LEXV>0&(LEXV<X)
SET X=X-LEXV
+3 SET LEXH=X\3600
SET LEXV=LEXH*3600
if +LEXV>0&(LEXV<X)
SET X=X-LEXV
+4 if $LENGTH(LEXH)<2
SET LEXH="0"_LEXH
if $LENGTH(LEXH)<2
SET LEXH="0"_LEXH
+5 SET LEXM=X\60
SET LEXV=LEXM*60
if +LEXV>0&(LEXV<X)
SET X=X-LEXV
+6 if $LENGTH(LEXM)<2
SET LEXM="0"_LEXM
if $LENGTH(LEXM)<2
SET LEXM="0"_LEXM
+7 SET LEXS=X
if $LENGTH(LEXS)<2
SET LEXS="0"_LEXS
if $LENGTH(LEXS)<2
SET LEXS="0"_LEXS
+8 SET LEXT=""
if +LEXD>0
SET LEXT=+LEXD_" day"_$SELECT(+LEXD>1:"s",1:"")_" "
+9 SET LEXT=LEXT_LEXH_":"_LEXM_":"_LEXS
SET X=LEXT
+10 QUIT X
BL ; Blank Line
+1 DO TL("")
QUIT
TL(LEXX) ; Text Line
+1 SET LEXSUB=$GET(LEXSUB)
if '$LENGTH(LEXSUB)
SET LEXSUB="LEXXII"
+2 IF '$DATA(^TMP(LEXSUB,$JOB,1))
SET ^TMP(LEXSUB,$JOB,1)=" "
SET ^TMP(LEXSUB,$JOB,0)=1
+3 NEW LEXNX
SET LEXNX=$ORDER(^TMP(LEXSUB,$JOB," "),-1)
SET LEXNX=LEXNX+1
+4 SET ^TMP(LEXSUB,$JOB,LEXNX)=" "_$GET(LEXX)
SET ^TMP(LEXSUB,$JOB,0)=LEXNX
+5 QUIT
ST ; Show Temp Array
+1 SET LEXSUB=$GET(LEXSUB)
if '$LENGTH(LEXSUB)
SET LEXSUB="LEXXII"
+2 NEW LEXN,LEXC
SET LEXN="^TMP("""_LEXSUB_""","_$JOB_")"
SET LEXC="^TMP("""_LEXSUB_""","_$JOB_","
+3 FOR
SET LEXN=$QUERY(@LEXN)
if LEXN=""!(LEXN'[LEXC)
QUIT
Begin DoDot:1
+4 if LEXN[",0)"
QUIT
WRITE !,@LEXN
End DoDot:1
+5 QUIT
TRIM(X) ; Trim Spaces
+1 SET X=$GET(X)
if X=""
QUIT X
FOR
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 FOR
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+3 QUIT X
