- 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 Mar 13, 2025@21:14:50 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
