LEXWUM ;ISL/KER - Lexicon Keywords - Update (Misc) ;05/23/2017
;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^LEX(757.071, SACC 1.3
; ^TMP("LEXWU",$J) SACC 2.3.2.5.1
;
; External References
; HOME^%ZIS ICR 10086
; DESC^%ZTLOAD ICR 10063
; STAT^%ZTLOAD ICR 10063
; $$GET1^DIQ ICR 2056
; $$DT^XLFDT ICR 10103
; $$FMDIFF^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$HTFM^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
;
; Local Variables NEWed or KILLed Elsewhere
; LEXCAP Output Delimited String (capture)
; LEXCHK Flag to check for one task
; LEXONE Call Task Monitor Once
;
Q
RUN(X) ; TaskMan Running Task
;
; This entry point checks TaskMan to see if the the
; Keyword Update is still running.
;
N LEXTDES,LEXRUN,LEXTT,LEXIT,Y S LEXTT=0,LEXIT=0
S LEXTDES=$G(X) I $L(LEXTDES) D Q X
. S X=1,LEXRUN=$$TSKM(LEXTDES) S X=+($G(LEXRUN)) D:+LEXRUN>0 MOND(LEXRUN,0)
. I '$D(LEXCHK),LEXRUN'>0 W:$$OUT>0 !," Keyword Update Utility is not running"
S LEXRUN=$$ASK("Keyword Update Utility (Purge Inactive)") S LEXTT=LEXTT+LEXRUN
I +LEXRUN'>0 S LEXRUN=$$ASK("Keyword Update Utility (Purge Selected Keyword)") S LEXTT=LEXTT+LEXRUN
I +LEXRUN'>0 S LEXRUN=$$ASK("Keyword Update Utility") S LEXTT=LEXTT+LEXRUN
I +LEXRUN'>0 S LEXRUN=$$ASK("Keyword Update Utility (Selected Keyword)") S LEXTT=LEXTT+LEXRUN
I +LEXRUN'>0 S LEXRUN=$$ASK("Test Keyword Update Utility") S LEXTT=LEXTT+LEXRUN
I +LEXRUN'>0 S LEXRUN=$$ASK("Keyword Update Utility (Dupes)") S LEXTT=LEXTT+LEXRUN
S:LEXTT>0 LEXIT=1 I '$D(LEXCHK),LEXTT'>0 W:$$OUT>0 !," Keyword Update Utility is not running"
S X=LEXIT
Q X
RUN2(X) ; TaskMan Running Task
N LEXRUN,LEXTSK,LEXQUIET S LEXRUN=+($G(LEXRUN)),LEXTSK="",LEXQUIET=1
I +LEXRUN'>0 S LEXTSK="Keyword Update Utility (Dupes)",LEXRUN=$$ASK(LEXTSK)
I +LEXRUN'>0 S LEXTSK="Keyword Update Utility (Purge Inactive)",LEXRUN=$$ASK(LEXTSK)
I +LEXRUN'>0 S LEXTSK="Keyword Update Utility (Purge Selected Keyword)",LEXRUN=$$ASK(LEXTSK)
I +LEXRUN'>0 S LEXTSK="Keyword Update Utility (Set)",LEXRUN=$$ASK(LEXTSK)
I +LEXRUN'>0 S LEXTSK="Keyword Update Utility (Set Selected Keyword)",LEXRUN=$$ASK(LEXTSK)
I +LEXRUN'>0 S LEXTSK="Test Keyword Update Utility",LEXRUN=$$ASK(LEXTSK)
I LEXRUN>0 D Q X
. N LEXTXT,LEXT,LEXSTA,LEXNAM S X=LEXRUN,LEXT=$P(LEXRUN,"^",2),LEXNAM=$P(LEXRUN,"^",3) S:'$L(LEXNAM) LEXNAM=LEXTSK Q:'$L(LEXNAM)
. S LEXSTA=$P(LEXRUN,"^",4) S:LEXSTA["running" LEXSTA="task is running" S:LEXSTA["scheduled" LEXSTA="task is scheduled"
. S LEXTXT=""""_LEXNAM_""" "_LEXSTA S:+LEXT>0 LEXTXT=LEXTXT_" (#"_+LEXT_")" S (X,LEXRUN)="1^"_LEXTXT
S:LEXRUN'>0 LEXTSK="Keyword Update Utility is not running" S X=+($G(LEXRUN))_"^"_LEXTSK
Q X
STOP ; Stop Task
N LEXRUN,LEXQUIET S LEXQUIET=1
S LEXRUN=$$ASK("Keyword Update Utility (Purge Inactive)")
S:+LEXRUN'>0 LEXRUN=$$ASK("Keyword Update Utility (Purge Selected Keyword)")
S:+LEXRUN'>0 LEXRUN=$$ASK("Keyword Update Utility")
S:+LEXRUN'>0 LEXRUN=$$ASK("Keyword Update Utility (Selected Keyword)")
S:+LEXRUN'>0 LEXRUN=$$ASK("Test Keyword Update Utility")
S:+LEXRUN'>0 LEXRUN=$$ASK("Keyword Update Utility (Dupes)")
I +LEXRUN>0 D
. N LEXT,LEXJ S LEXT=+($P(LEXRUN,"^",2)) Q:+LEXT'>0 S LEXJ=$$GET1^DIQ(14.4,(LEXT_","),54) I +LEXJ>0 S ^TMP("LEXWU",+LEXJ,"STOP")=""
Q
MON ; TaskMan Monitor
;
; This entry point monitors TaskMan Keyword Update
; Utility and reports its progress. The user must
; enter an up-arrow "^" to exit the monitor loop.
; The task monitor will also quit when the task quits.
;
N LEXIT,LEXINC S LEXIT=0,LEXINC=0 F D W:+LEXIT>0&($$OUT>0) !! Q:+LEXIT>0
. N LEXTT,LEXTDES S LEXTT=0 W:$L($G(IOF))&($$OUT>0) @IOF S LEXINC=LEXINC+1 S:$D(LEXONE) LEXIT=1
. S LEXRUN=$$ASK("Keyword Update Utility (Purge Inactive)") S LEXTT=LEXTT+LEXRUN
. S LEXRUN=$$ASK("Keyword Update Utility (Purge Selected Keyword)") S LEXTT=LEXTT+LEXRUN
. S LEXRUN=$$ASK("Keyword Update Utility") S LEXTT=LEXTT+LEXRUN
. S LEXRUN=$$ASK("Keyword Update Utility (Selected Keyword)") S LEXTT=LEXTT+LEXRUN
. S LEXRUN=$$ASK("Test Keyword Update Utility") S LEXTT=LEXTT+LEXRUN
. S LEXRUN=$$ASK("Keyword Update Utility (Dupes)") S LEXTT=LEXTT+LEXRUN
. I LEXTT'>0 D Q
. . W:$$OUT>0 !!,"Keyword Update Task not found/running",! S LEXIT=1 Q
. I '$D(LEXONE) S LEXTT=$$PAUSE I $L(LEXTT) S LEXIT=1 Q
Q
ASK(X) ; Ask if Running
N LEXTDES,LEXRUN S LEXTDES=$G(X) Q:'$L(LEXTDES) 0
S LEXRUN=$$TSKM(LEXTDES) D:+LEXRUN>0 MOND(LEXRUN,0) S X=LEXRUN
Q X
MOND(X,Y) ; TaskMan Monitor Display
N LEXE,LEXI,LEXN,LEXCUR,LEXR,LEXS,LEXT S LEXI=+($G(Y))
S LEXT=$P($G(X),"^",2),LEXN=$P($G(X),"^",3),LEXS=$P($G(X),"^",4),LEXCUR=$$NOW^XLFDT
S LEXR="" S:LEXT>0 LEXR=$$GET1^DIQ(14.4,(LEXT_","),6) S:$L(LEXR) LEXR=$$HTFM^XLFDT(LEXR) S LEXE=""
I $P(LEXR,".",1)?7N,LEXR<LEXCUR S LEXE=$$FMDIFF^XLFDT(LEXCUR,LEXR,3) S:$E(LEXE,1)=" "&($L($P(LEXE,":",1))=2) LEXE=$TR(LEXE," ","0")
I $D(LEXONE) D Q
. W:$$OUT>0 !,?3,LEXT," ",LEXN,?70,LEXE W:$L(LEXS)&($$OUT>0) !,?3,$J(" ",$L(LEXT))," ",LEXS S LEXIT=1 Q
I LEXI>0 W:$$OUT>0 !," " W:LEXI>1&($$OUT>0) LEXI W:$$OUT>0 ?6,$J(LEXT,10),?20,LEXN,?70,LEXE W:$L(LEXS)&($$OUT>0) !,?20,LEXS Q
S:LEXS["The task is " LEXS=$P(LEXS,"The task ",2) S:LEXN'["""" LEXN=""""_LEXN_""""
W:$$OUT>0 !," ",LEXN W:$L(LEXS)&($$OUT>0) " ",LEXS W:+LEXT>0&($$OUT>0) " (#",+LEXT,")" W:$$OUT>0 !
Q
TSKM(X) ; TaskMan
N ZT,ZTUCI,ZTKEY,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,LEXRUN,LEXTMP,Y S ZTDESC=$G(X) Q:'$L(ZTDESC) 0
K LEXTMP D DESC^%ZTLOAD(ZTDESC,"LEXTMP") Q:$O(LEXTMP(0))'>0 0 S LEXRUN=0,ZTSK=0 F S ZTSK=$O(LEXTMP(ZTSK)) Q:+ZTSK'>0 D
. D STAT^%ZTLOAD Q:+($G(ZTSK(0)))'>0 Q:"^0^3^4^5^"[("^"_+($G(ZTSK(1)))_"^")
. S:+($G(ZTSK(1)))=1 LEXRUN=("1^"_ZTSK_"^"_ZTDESC_"^The task is scheduled to run")
. S:+($G(ZTSK(1)))=2 LEXRUN=("2^"_ZTSK_"^"_ZTDESC_"^The task is running")
S X=LEXRUN
Q X
;
; Miscellaneous
DT ; Display ^TMP
N LEXT,LEXBEG,LEXEND,LEXHDR,LEXDIRA
W:$D(^TMP("LEXWU",$J,"RESULTS","CHG"))!($D(^TMP("LEXWU",$J,"RESULTS","TIM"))) !
W:$D(LEXMENU)&($L($G(IOF))) @IOF
S LEXHDR="",LEXT=$G(^TMP("LEXWU",$J,"RESULTS","CHG","LEX"))
W:+LEXT>0 !,?3,"Lexicon Changes ",?32,$J(LEXT,8) W:+LEXT'>0 !,?3,"Lexicon Changes ",?32,$J("None",8)
S (LEXT,LEXHDR)=$G(^TMP("LEXWU",$J,"RESULTS","CHG","DIA"))
W:+LEXT'>0 !,?3,"ICD Diagnosis Changes ",?32,$J("None",8) I +LEXT>0 D
. W !,?3,"ICD Diagnosis Changes ",?32,$J(LEXT,8)
. S LEXT=$G(^TMP("LEXWU",$J,"RESULTS","CHG","ICD"))
. I +LEXT>0 W:+LEXHDR'>0 !,?3 W:+LEXHDR>0 !,?5 W "ICD-9 Diagnosis Changes ",?32,$J(LEXT,8)
. S LEXT=$G(^TMP("LEXWU",$J,"RESULTS","CHG","10D"))
. I +LEXT>0 W:+LEXHDR'>0 !,?3 W:+LEXHDR>0 !,?5 W "ICD-10 Diagnosis Changes ",?32,$J(LEXT,8)
S (LEXT,LEXHDR)=""
W:+LEXT'>0 !,?3,"ICD Procedure Changes ",?32,$J("None",8) I +LEXT>0 D
. W !,?3,"ICD Procedure Changes ",?32,$J(LEXT,8)
. S LEXT=$G(^TMP("LEXWU",$J,"RESULTS","CHG","ICP"))
. I +LEXT>0 W:+LEXHDR'>0 !,?3 W:+LEXHDR>0 !,?5 W "ICD-9 Procedure Changes ",?32,$J(LEXT,8)
. S LEXT=$G(^TMP("LEXWU",$J,"RESULTS","CHG","10P"))
. I +LEXT>0 W:+LEXHDR'>0 !,?3 W:+LEXHDR>0 !,?5 W "ICD-10 Procedures Changes ",?32,$J(LEXT,8)
S LEXT=$G(^TMP("LEXWU",$J,"RESULTS","CHG","SCT"))
W:+LEXT>0 !,?3,"SNOMED CT Changes ",?32,$J(LEXT,8) W:+LEXT'>0 !,?3,"SNOMED CT Changes ",?32,$J("None",8)
S LEXT=$G(^TMP("LEXWU",$J,"RESULTS","CHG","SCC"))
W:+LEXT>0 !,?3,"TITLE 38 Changes ",?32,$J(LEXT,8) W:+LEXT'>0 !,?3,"TITLE 38 Changes ",?32,$J("None",8)
W:($D(^TMP("LEXWU",$J,"RESULTS","TIM"))) !
S (LEXBEG,LEXT)=$G(^TMP("LEXWU",$J,"RESULTS","TIM","BEG"))
W:$L($P(LEXT,"^",1))&($L($P(LEXT,"^",2))) !,?3,$P(LEXT,"^",1),?14,$P(LEXT,"^",2)
S (LEXEND,LEXT)=$G(^TMP("LEXWU",$J,"RESULTS","TIM","END"))
W:$L($P(LEXT,"^",1))&($L($P(LEXT,"^",2))) !,?3,$P(LEXT,"^",1),?14,$P(LEXT,"^",2)
S LEXT=$G(^TMP("LEXWU",$J,"RESULTS","TIM","TIM"))
S:'$L(LEXT)&($L($P(LEXBEG,"^",2)))&($P(LEXBEG,"^",2)=$P(LEXEND,"^",2)) LEXT="Elapsed: "_"^00:00:00"
W:$L($P(LEXT,"^",1))&($L($P(LEXT,"^",2))) !,?3,$P(LEXT,"^",1),?14,$P(LEXT,"^",2)
W:$D(^TMP("LEXWU",$J,"RESULTS","CHG"))!($D(^TMP("LEXWU",$J,"RESULTS","TIM"))) !
W:$D(LEXMENU)&('$D(^TMP("LEXWU",$J,"RESULTS"))) !
S LEXDIRA=" Press <Return> to continue " D:$D(LEXMENU) CONT^LEXWUM W:'$D(LEXMENU) !
N LEXMENU
Q
LISTI ; List Inactive Keywords
N LEXORD,LEXC S LEXC=8 S LEXORD="" F S LEXORD=$O(^LEX(757.071,"B",LEXORD)) Q:'$L(LEXORD) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(757.071,"B",LEXORD,+LEXIEN)) Q:+LEXIEN'>0 D
. . N LEXKEY,LEXEFF,LEXINA,LEXINC,LEXSTA S LEXSTA=$$INA(LEXIEN) Q:+LEXSTA'>0
. . S LEXKEY=$P($G(^LEX(757.071,+LEXIEN,0)),"^",1),LEXEFF=$P($G(^LEX(757.071,+LEXIEN,0)),"^",2)
. . S LEXINA=$P($G(^LEX(757.071,+LEXIEN,0)),"^",3),LEXINC=$P($G(^LEX(757.071,+LEXIEN,0)),"^",4)
. . I $D(LEXCAP) W !,LEXKEY,"~",LEXINC,"~",$S(LEXEFF?7N:$$FMTE^XLFDT(LEXEFF,"5Z"),1:""),"~",$S(LEXINA?7N:$$FMTE^XLFDT(LEXINA,"5Z"),1:""),"|" Q
. . W !,LEXKEY W:$L($G(LEXINC)) ?LEXC," ",LEXINC
. . W !,?LEXC," Effective:",?(LEXC+12)," ",$$FMTE^XLFDT(LEXEFF,"5Z")
. . W:$L(LEXINA) ?(LEXC+24)," Inactive:",(LEXC+35)," ",$$FMTE^XLFDT(LEXINA,"5Z")
. . W !
K LEXAFT
Q
LISTA ; List Active Keywords
N LEXORD,LEXC S LEXC=8 S LEXORD="" F S LEXORD=$O(^LEX(757.071,"B",LEXORD)) Q:'$L(LEXORD) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(757.071,"B",LEXORD,+LEXIEN)) Q:+LEXIEN'>0 D
. . N LEXKEY,LEXEFF,LEXINA,LEXINC,LEXSTA S LEXSTA=$$ACT(LEXIEN) Q:+LEXSTA'>0
. . S LEXKEY=$P($G(^LEX(757.071,+LEXIEN,0)),"^",1),LEXEFF=$P($G(^LEX(757.071,+LEXIEN,0)),"^",2)
. . S LEXINA=$P($G(^LEX(757.071,+LEXIEN,0)),"^",3),LEXINC=$P($G(^LEX(757.071,+LEXIEN,0)),"^",4)
. . I $D(LEXCAP) W !,LEXKEY,"~",LEXINC,"~",$S(LEXEFF?7N:$$FMTE^XLFDT(LEXEFF,"5Z"),1:""),"~",$S(LEXINA?7N:$$FMTE^XLFDT(LEXINA,"5Z"),1:""),"|" Q
. . W !,LEXKEY W:$L($G(LEXINC)) ?LEXC," ",LEXINC
. . W !,?LEXC," Effective:",?(LEXC+12)," ",$$FMTE^XLFDT(LEXEFF,"5Z")
. . W:$L(LEXINA) ?(LEXC+24)," Inactive:",(LEXC+35)," ",$$FMTE^XLFDT(LEXINA,"5Z")
. . W !
K LEXAFT
Q
INA(X) ; Inactive before Today or after LEXAFT (optional)
N LEXI,LEX1,LEX2,LEXA,LEXT,LEXO S LEXT=$$DT^XLFDT,LEXI=+($G(X)),LEX1=+($P($P($G(^LEX(757.071,+LEXI,0)),"^",2),".",1)) Q:LEX1'?7N "0^1"
S LEX2=+($P($P($G(^LEX(757.071,+LEXI,0)),"^",3),".",1)) Q:LEX2'?7N "0^2" S LEXA=$G(LEXAFT),LEXO=0
; If Inactive after LEXAFT and not later Active 1
Q:($G(LEXA)?7N)&((LEX2+.001)>LEXA)&((LEX2+.001)>LEX1) "1^3"
; If Inactive after LEXAFT and later Active 0
Q:($G(LEXA)?7N)&((LEX2+.001)>LEXA)&((LEX1+.001)>LEX2) "0^4"
; If Inactive before LEXAFT and not later Active 0
Q:($G(LEXA)?7N)&((LEXA+.001)>LEX2)&((LEX2+.001)>LEX1) "0^5"
; If Inactive 1
Q:(LEX2+.001)>LEX1 "1^6"
; Else Active 0
Q "0^7"
ACT(X) ; Active before Today or after LEXAFT (optional)
N LEXI,LEX1,LEX2,LEXA,LEXT,LEXO S LEXT=$$DT^XLFDT,LEXI=+($G(X)),LEX1=+($P($P($G(^LEX(757.071,+LEXI,0)),"^",2),".",1)) Q:LEX1'?7N "0^1"
S LEX2=+($P($P($G(^LEX(757.071,+LEXI,0)),"^",3),".",1)),LEXA=$G(LEXAFT),LEXO=0
; If Active after LEXAFT and not later Inctive 1
Q:($G(LEXA)?7N)&((LEX1+.001)>LEXA)&((LEX1+.001)>LEX2) "1^2"
; If Active after LEXAFT and later Inactive 0
Q:($G(LEXA)?7N)&((LEX1+.001)>LEXA)&((LEX2+.001)>LEX1) "0^3"
; If Active before LEXAFT and not later Inactive 0
Q:($G(LEXA)?7N)&((LEXA+.001)>LEX1)&((LEX1+.001)>LEX2) "0^4"
; If Active 1
Q:(LEX1+.001)>LEX2 "1^5"
; Else Inactive 0
Q "0^6"
OUT(X) ; Output
Q:$D(LEXQUIET) 0 Q:$D(ZTQUEUED) 0
Q 1
TM(X,Y) ; Trim Spaces
S X=$G(X) Q:X="" X S Y=$E($G(Y),1) S:'$L(Y) Y=" " F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
ZERO ; ^LEX(757.071,0)
N LEXIEN,LEXP1,LEXP2,LEXP3,LEXP4 S (LEXIEN,LEXP3,LEXP4)=0,LEXP1=$P($G(^LEX(757.071,0)),"^",1),LEXP2=$P($G(^LEX(757.071,0)),"^",2)
Q:'$L(LEXP1) Q:'$L(LEXP2) Q:LEXP2'["757.071" F S LEXIEN=$O(^LEX(757.071,LEXIEN)) Q:+LEXIEN'>0 S LEXP4=LEXP4+1
S LEXP3=$O(^LEX(757.071," "),-1) S:LEXP3'>0 LEXP3="" S:LEXP4>0 ^LEX(757.071,0)=LEXP1_"^"_LEXP2_"^"_LEXP3_"^"_LEXP4
Q
PAUSE(X) ; Pause Monitor
N LEXCONT,LEXPMT S LEXPMT=" Press <Return> to continue or ""^"" to exit " W !!,LEXPMT R LEXCONT:2 Q:LEXCONT["^" "^"
Q ""
CONT ; Continue
N LEXCONT,LEXPMT I IOST["P-" U IO W:$L($G(IOF)) @IOF Q
S LEXPMT=" Press <Return> to continue " S:$L($G(LEXDIRA)) LEXPMT=LEXDIRA
W:'$L($G(LEXDIRA)) ! W !,LEXPMT R LEXCONT:660 N LEXDIRA
I '$T!(LEXCONT["^") W:$L($G(IOF)) @IOF K LEXCONT S LEXIT=1 Q
W:$L($G(IOF)) @IOF
Q
ENV(X) ; Environment
D HOME^%ZIS S U="^",DT=$$DT^XLFDT,DTIME=300 K POP
N LEXNM S LEXNM=$$GET1^DIQ(200,(DUZ_","),.01)
I '$L(LEXNM) W !!,?5,"Invalid/Missing DUZ" N LEXCAP,LEXCHK,LEXONE Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXWUM 13261 printed Dec 13, 2024@02:10 Page 2
LEXWUM ;ISL/KER - Lexicon Keywords - Update (Misc) ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^LEX(757.071, SACC 1.3
+5 ; ^TMP("LEXWU",$J) SACC 2.3.2.5.1
+6 ;
+7 ; External References
+8 ; HOME^%ZIS ICR 10086
+9 ; DESC^%ZTLOAD ICR 10063
+10 ; STAT^%ZTLOAD ICR 10063
+11 ; $$GET1^DIQ ICR 2056
+12 ; $$DT^XLFDT ICR 10103
+13 ; $$FMDIFF^XLFDT ICR 10103
+14 ; $$FMTE^XLFDT ICR 10103
+15 ; $$HTFM^XLFDT ICR 10103
+16 ; $$NOW^XLFDT ICR 10103
+17 ;
+18 ; Local Variables NEWed or KILLed Elsewhere
+19 ; LEXCAP Output Delimited String (capture)
+20 ; LEXCHK Flag to check for one task
+21 ; LEXONE Call Task Monitor Once
+22 ;
+23 QUIT
RUN(X) ; TaskMan Running Task
+1 ;
+2 ; This entry point checks TaskMan to see if the the
+3 ; Keyword Update is still running.
+4 ;
+5 NEW LEXTDES,LEXRUN,LEXTT,LEXIT,Y
SET LEXTT=0
SET LEXIT=0
+6 SET LEXTDES=$GET(X)
IF $LENGTH(LEXTDES)
Begin DoDot:1
+7 SET X=1
SET LEXRUN=$$TSKM(LEXTDES)
SET X=+($GET(LEXRUN))
if +LEXRUN>0
DO MOND(LEXRUN,0)
+8 IF '$DATA(LEXCHK)
IF LEXRUN'>0
if $$OUT>0
WRITE !," Keyword Update Utility is not running"
End DoDot:1
QUIT X
+9 SET LEXRUN=$$ASK("Keyword Update Utility (Purge Inactive)")
SET LEXTT=LEXTT+LEXRUN
+10 IF +LEXRUN'>0
SET LEXRUN=$$ASK("Keyword Update Utility (Purge Selected Keyword)")
SET LEXTT=LEXTT+LEXRUN
+11 IF +LEXRUN'>0
SET LEXRUN=$$ASK("Keyword Update Utility")
SET LEXTT=LEXTT+LEXRUN
+12 IF +LEXRUN'>0
SET LEXRUN=$$ASK("Keyword Update Utility (Selected Keyword)")
SET LEXTT=LEXTT+LEXRUN
+13 IF +LEXRUN'>0
SET LEXRUN=$$ASK("Test Keyword Update Utility")
SET LEXTT=LEXTT+LEXRUN
+14 IF +LEXRUN'>0
SET LEXRUN=$$ASK("Keyword Update Utility (Dupes)")
SET LEXTT=LEXTT+LEXRUN
+15 if LEXTT>0
SET LEXIT=1
IF '$DATA(LEXCHK)
IF LEXTT'>0
if $$OUT>0
WRITE !," Keyword Update Utility is not running"
+16 SET X=LEXIT
+17 QUIT X
RUN2(X) ; TaskMan Running Task
+1 NEW LEXRUN,LEXTSK,LEXQUIET
SET LEXRUN=+($GET(LEXRUN))
SET LEXTSK=""
SET LEXQUIET=1
+2 IF +LEXRUN'>0
SET LEXTSK="Keyword Update Utility (Dupes)"
SET LEXRUN=$$ASK(LEXTSK)
+3 IF +LEXRUN'>0
SET LEXTSK="Keyword Update Utility (Purge Inactive)"
SET LEXRUN=$$ASK(LEXTSK)
+4 IF +LEXRUN'>0
SET LEXTSK="Keyword Update Utility (Purge Selected Keyword)"
SET LEXRUN=$$ASK(LEXTSK)
+5 IF +LEXRUN'>0
SET LEXTSK="Keyword Update Utility (Set)"
SET LEXRUN=$$ASK(LEXTSK)
+6 IF +LEXRUN'>0
SET LEXTSK="Keyword Update Utility (Set Selected Keyword)"
SET LEXRUN=$$ASK(LEXTSK)
+7 IF +LEXRUN'>0
SET LEXTSK="Test Keyword Update Utility"
SET LEXRUN=$$ASK(LEXTSK)
+8 IF LEXRUN>0
Begin DoDot:1
+9 NEW LEXTXT,LEXT,LEXSTA,LEXNAM
SET X=LEXRUN
SET LEXT=$PIECE(LEXRUN,"^",2)
SET LEXNAM=$PIECE(LEXRUN,"^",3)
if '$LENGTH(LEXNAM)
SET LEXNAM=LEXTSK
if '$LENGTH(LEXNAM)
QUIT
+10 SET LEXSTA=$PIECE(LEXRUN,"^",4)
if LEXSTA["running"
SET LEXSTA="task is running"
if LEXSTA["scheduled"
SET LEXSTA="task is scheduled"
+11 SET LEXTXT=""""_LEXNAM_""" "_LEXSTA
if +LEXT>0
SET LEXTXT=LEXTXT_" (#"_+LEXT_")"
SET (X,LEXRUN)="1^"_LEXTXT
End DoDot:1
QUIT X
+12 if LEXRUN'>0
SET LEXTSK="Keyword Update Utility is not running"
SET X=+($GET(LEXRUN))_"^"_LEXTSK
+13 QUIT X
STOP ; Stop Task
+1 NEW LEXRUN,LEXQUIET
SET LEXQUIET=1
+2 SET LEXRUN=$$ASK("Keyword Update Utility (Purge Inactive)")
+3 if +LEXRUN'>0
SET LEXRUN=$$ASK("Keyword Update Utility (Purge Selected Keyword)")
+4 if +LEXRUN'>0
SET LEXRUN=$$ASK("Keyword Update Utility")
+5 if +LEXRUN'>0
SET LEXRUN=$$ASK("Keyword Update Utility (Selected Keyword)")
+6 if +LEXRUN'>0
SET LEXRUN=$$ASK("Test Keyword Update Utility")
+7 if +LEXRUN'>0
SET LEXRUN=$$ASK("Keyword Update Utility (Dupes)")
+8 IF +LEXRUN>0
Begin DoDot:1
+9 NEW LEXT,LEXJ
SET LEXT=+($PIECE(LEXRUN,"^",2))
if +LEXT'>0
QUIT
SET LEXJ=$$GET1^DIQ(14.4,(LEXT_","),54)
IF +LEXJ>0
SET ^TMP("LEXWU",+LEXJ,"STOP")=""
End DoDot:1
+10 QUIT
MON ; TaskMan Monitor
+1 ;
+2 ; This entry point monitors TaskMan Keyword Update
+3 ; Utility and reports its progress. The user must
+4 ; enter an up-arrow "^" to exit the monitor loop.
+5 ; The task monitor will also quit when the task quits.
+6 ;
+7 NEW LEXIT,LEXINC
SET LEXIT=0
SET LEXINC=0
FOR
Begin DoDot:1
+8 NEW LEXTT,LEXTDES
SET LEXTT=0
if $LENGTH($GET(IOF))&($$OUT>0)
WRITE @IOF
SET LEXINC=LEXINC+1
if $DATA(LEXONE)
SET LEXIT=1
+9 SET LEXRUN=$$ASK("Keyword Update Utility (Purge Inactive)")
SET LEXTT=LEXTT+LEXRUN
+10 SET LEXRUN=$$ASK("Keyword Update Utility (Purge Selected Keyword)")
SET LEXTT=LEXTT+LEXRUN
+11 SET LEXRUN=$$ASK("Keyword Update Utility")
SET LEXTT=LEXTT+LEXRUN
+12 SET LEXRUN=$$ASK("Keyword Update Utility (Selected Keyword)")
SET LEXTT=LEXTT+LEXRUN
+13 SET LEXRUN=$$ASK("Test Keyword Update Utility")
SET LEXTT=LEXTT+LEXRUN
+14 SET LEXRUN=$$ASK("Keyword Update Utility (Dupes)")
SET LEXTT=LEXTT+LEXRUN
+15 IF LEXTT'>0
Begin DoDot:2
+16 if $$OUT>0
WRITE !!,"Keyword Update Task not found/running",!
SET LEXIT=1
QUIT
End DoDot:2
QUIT
+17 IF '$DATA(LEXONE)
SET LEXTT=$$PAUSE
IF $LENGTH(LEXTT)
SET LEXIT=1
QUIT
End DoDot:1
if +LEXIT>0&($$OUT>0)
WRITE !!
if +LEXIT>0
QUIT
+18 QUIT
ASK(X) ; Ask if Running
+1 NEW LEXTDES,LEXRUN
SET LEXTDES=$GET(X)
if '$LENGTH(LEXTDES)
QUIT 0
+2 SET LEXRUN=$$TSKM(LEXTDES)
if +LEXRUN>0
DO MOND(LEXRUN,0)
SET X=LEXRUN
+3 QUIT X
MOND(X,Y) ; TaskMan Monitor Display
+1 NEW LEXE,LEXI,LEXN,LEXCUR,LEXR,LEXS,LEXT
SET LEXI=+($GET(Y))
+2 SET LEXT=$PIECE($GET(X),"^",2)
SET LEXN=$PIECE($GET(X),"^",3)
SET LEXS=$PIECE($GET(X),"^",4)
SET LEXCUR=$$NOW^XLFDT
+3 SET LEXR=""
if LEXT>0
SET LEXR=$$GET1^DIQ(14.4,(LEXT_","),6)
if $LENGTH(LEXR)
SET LEXR=$$HTFM^XLFDT(LEXR)
SET LEXE=""
+4 IF $PIECE(LEXR,".",1)?7N
IF LEXR<LEXCUR
SET LEXE=$$FMDIFF^XLFDT(LEXCUR,LEXR,3)
if $EXTRACT(LEXE,1)=" "&($LENGTH($PIECE(LEXE,"
SET LEXE=$TRANSLATE(LEXE," ","0")
+5 IF $DATA(LEXONE)
Begin DoDot:1
+6 if $$OUT>0
WRITE !,?3,LEXT," ",LEXN,?70,LEXE
if $LENGTH(LEXS)&($$OUT>0)
WRITE !,?3,$JUSTIFY(" ",$LENGTH(LEXT))," ",LEXS
SET LEXIT=1
QUIT
End DoDot:1
QUIT
+7 IF LEXI>0
if $$OUT>0
WRITE !," "
if LEXI>1&($$OUT>0)
WRITE LEXI
if $$OUT>0
WRITE ?6,$JUSTIFY(LEXT,10),?20,LEXN,?70,LEXE
if $LENGTH(LEXS)&($$OUT>0)
WRITE !,?20,LEXS
QUIT
+8 if LEXS["The task is "
SET LEXS=$PIECE(LEXS,"The task ",2)
if LEXN'[""""
SET LEXN=""""_LEXN_""""
+9 if $$OUT>0
WRITE !," ",LEXN
if $LENGTH(LEXS)&($$OUT>0)
WRITE " ",LEXS
if +LEXT>0&($$OUT>0)
WRITE " (#",+LEXT,")"
if $$OUT>0
WRITE !
+10 QUIT
TSKM(X) ; TaskMan
+1 NEW ZT,ZTUCI,ZTKEY,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,LEXRUN,LEXTMP,Y
SET ZTDESC=$GET(X)
if '$LENGTH(ZTDESC)
QUIT 0
+2 KILL LEXTMP
DO DESC^%ZTLOAD(ZTDESC,"LEXTMP")
if $ORDER(LEXTMP(0))'>0
QUIT 0
SET LEXRUN=0
SET ZTSK=0
FOR
SET ZTSK=$ORDER(LEXTMP(ZTSK))
if +ZTSK'>0
QUIT
Begin DoDot:1
+3 DO STAT^%ZTLOAD
if +($GET(ZTSK(0)))'>0
QUIT
if "^0^3^4^5^"[("^"_+($GET(ZTSK(1)))_"^")
QUIT
+4 if +($GET(ZTSK(1)))=1
SET LEXRUN=("1^"_ZTSK_"^"_ZTDESC_"^The task is scheduled to run")
+5 if +($GET(ZTSK(1)))=2
SET LEXRUN=("2^"_ZTSK_"^"_ZTDESC_"^The task is running")
End DoDot:1
+6 SET X=LEXRUN
+7 QUIT X
+8 ;
+9 ; Miscellaneous
DT ; Display ^TMP
+1 NEW LEXT,LEXBEG,LEXEND,LEXHDR,LEXDIRA
+2 if $DATA(^TMP("LEXWU",$JOB,"RESULTS","CHG"))!($DATA(^TMP("LEXWU",$JOB,"RESULTS","TIM")))
WRITE !
+3 if $DATA(LEXMENU)&($LENGTH($GET(IOF)))
WRITE @IOF
+4 SET LEXHDR=""
SET LEXT=$GET(^TMP("LEXWU",$JOB,"RESULTS","CHG","LEX"))
+5 if +LEXT>0
WRITE !,?3,"Lexicon Changes ",?32,$JUSTIFY(LEXT,8)
if +LEXT'>0
WRITE !,?3,"Lexicon Changes ",?32,$JUSTIFY("None",8)
+6 SET (LEXT,LEXHDR)=$GET(^TMP("LEXWU",$JOB,"RESULTS","CHG","DIA"))
+7 if +LEXT'>0
WRITE !,?3,"ICD Diagnosis Changes ",?32,$JUSTIFY("None",8)
IF +LEXT>0
Begin DoDot:1
+8 WRITE !,?3,"ICD Diagnosis Changes ",?32,$JUSTIFY(LEXT,8)
+9 SET LEXT=$GET(^TMP("LEXWU",$JOB,"RESULTS","CHG","ICD"))
+10 IF +LEXT>0
if +LEXHDR'>0
WRITE !,?3
if +LEXHDR>0
WRITE !,?5
WRITE "ICD-9 Diagnosis Changes ",?32,$JUSTIFY(LEXT,8)
+11 SET LEXT=$GET(^TMP("LEXWU",$JOB,"RESULTS","CHG","10D"))
+12 IF +LEXT>0
if +LEXHDR'>0
WRITE !,?3
if +LEXHDR>0
WRITE !,?5
WRITE "ICD-10 Diagnosis Changes ",?32,$JUSTIFY(LEXT,8)
End DoDot:1
+13 SET (LEXT,LEXHDR)=""
+14 if +LEXT'>0
WRITE !,?3,"ICD Procedure Changes ",?32,$JUSTIFY("None",8)
IF +LEXT>0
Begin DoDot:1
+15 WRITE !,?3,"ICD Procedure Changes ",?32,$JUSTIFY(LEXT,8)
+16 SET LEXT=$GET(^TMP("LEXWU",$JOB,"RESULTS","CHG","ICP"))
+17 IF +LEXT>0
if +LEXHDR'>0
WRITE !,?3
if +LEXHDR>0
WRITE !,?5
WRITE "ICD-9 Procedure Changes ",?32,$JUSTIFY(LEXT,8)
+18 SET LEXT=$GET(^TMP("LEXWU",$JOB,"RESULTS","CHG","10P"))
+19 IF +LEXT>0
if +LEXHDR'>0
WRITE !,?3
if +LEXHDR>0
WRITE !,?5
WRITE "ICD-10 Procedures Changes ",?32,$JUSTIFY(LEXT,8)
End DoDot:1
+20 SET LEXT=$GET(^TMP("LEXWU",$JOB,"RESULTS","CHG","SCT"))
+21 if +LEXT>0
WRITE !,?3,"SNOMED CT Changes ",?32,$JUSTIFY(LEXT,8)
if +LEXT'>0
WRITE !,?3,"SNOMED CT Changes ",?32,$JUSTIFY("None",8)
+22 SET LEXT=$GET(^TMP("LEXWU",$JOB,"RESULTS","CHG","SCC"))
+23 if +LEXT>0
WRITE !,?3,"TITLE 38 Changes ",?32,$JUSTIFY(LEXT,8)
if +LEXT'>0
WRITE !,?3,"TITLE 38 Changes ",?32,$JUSTIFY("None",8)
+24 if ($DATA(^TMP("LEXWU",$JOB,"RESULTS","TIM")))
WRITE !
+25 SET (LEXBEG,LEXT)=$GET(^TMP("LEXWU",$JOB,"RESULTS","TIM","BEG"))
+26 if $LENGTH($PIECE(LEXT,"^",1))&($LENGTH($PIECE(LEXT,"^",2)))
WRITE !,?3,$PIECE(LEXT,"^",1),?14,$PIECE(LEXT,"^",2)
+27 SET (LEXEND,LEXT)=$GET(^TMP("LEXWU",$JOB,"RESULTS","TIM","END"))
+28 if $LENGTH($PIECE(LEXT,"^",1))&($LENGTH($PIECE(LEXT,"^",2)))
WRITE !,?3,$PIECE(LEXT,"^",1),?14,$PIECE(LEXT,"^",2)
+29 SET LEXT=$GET(^TMP("LEXWU",$JOB,"RESULTS","TIM","TIM"))
+30 if '$LENGTH(LEXT)&($LENGTH($PIECE(LEXBEG,"^",2)))&($PIECE(LEXBEG,"^",2)=$PIECE(LEXEND,"^",2))
SET LEXT="Elapsed: "_"^00:00:00"
+31 if $LENGTH($PIECE(LEXT,"^",1))&($LENGTH($PIECE(LEXT,"^",2)))
WRITE !,?3,$PIECE(LEXT,"^",1),?14,$PIECE(LEXT,"^",2)
+32 if $DATA(^TMP("LEXWU",$JOB,"RESULTS","CHG"))!($DATA(^TMP("LEXWU",$JOB,"RESULTS","TIM")))
WRITE !
+33 if $DATA(LEXMENU)&('$DATA(^TMP("LEXWU",$JOB,"RESULTS")))
WRITE !
+34 SET LEXDIRA=" Press <Return> to continue "
if $DATA(LEXMENU)
DO CONT^LEXWUM
if '$DATA(LEXMENU)
WRITE !
+35 NEW LEXMENU
+36 QUIT
LISTI ; List Inactive Keywords
+1 NEW LEXORD,LEXC
SET LEXC=8
SET LEXORD=""
FOR
SET LEXORD=$ORDER(^LEX(757.071,"B",LEXORD))
if '$LENGTH(LEXORD)
QUIT
Begin DoDot:1
+2 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(757.071,"B",LEXORD,+LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:2
+3 NEW LEXKEY,LEXEFF,LEXINA,LEXINC,LEXSTA
SET LEXSTA=$$INA(LEXIEN)
if +LEXSTA'>0
QUIT
+4 SET LEXKEY=$PIECE($GET(^LEX(757.071,+LEXIEN,0)),"^",1)
SET LEXEFF=$PIECE($GET(^LEX(757.071,+LEXIEN,0)),"^",2)
+5 SET LEXINA=$PIECE($GET(^LEX(757.071,+LEXIEN,0)),"^",3)
SET LEXINC=$PIECE($GET(^LEX(757.071,+LEXIEN,0)),"^",4)
+6 IF $DATA(LEXCAP)
WRITE !,LEXKEY,"~",LEXINC,"~",$SELECT(LEXEFF?7N:$$FMTE^XLFDT(LEXEFF,"5Z"),1:""),"~",$SELECT(LEXINA?7N:$$FMTE^XLFDT(LEXINA,"5Z"),1:""),"|"
QUIT
+7 WRITE !,LEXKEY
if $LENGTH($GET(LEXINC))
WRITE ?LEXC," ",LEXINC
+8 WRITE !,?LEXC," Effective:",?(LEXC+12)," ",$$FMTE^XLFDT(LEXEFF,"5Z")
+9 if $LENGTH(LEXINA)
WRITE ?(LEXC+24)," Inactive:",(LEXC+35)," ",$$FMTE^XLFDT(LEXINA,"5Z")
+10 WRITE !
End DoDot:2
End DoDot:1
+11 KILL LEXAFT
+12 QUIT
LISTA ; List Active Keywords
+1 NEW LEXORD,LEXC
SET LEXC=8
SET LEXORD=""
FOR
SET LEXORD=$ORDER(^LEX(757.071,"B",LEXORD))
if '$LENGTH(LEXORD)
QUIT
Begin DoDot:1
+2 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(757.071,"B",LEXORD,+LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:2
+3 NEW LEXKEY,LEXEFF,LEXINA,LEXINC,LEXSTA
SET LEXSTA=$$ACT(LEXIEN)
if +LEXSTA'>0
QUIT
+4 SET LEXKEY=$PIECE($GET(^LEX(757.071,+LEXIEN,0)),"^",1)
SET LEXEFF=$PIECE($GET(^LEX(757.071,+LEXIEN,0)),"^",2)
+5 SET LEXINA=$PIECE($GET(^LEX(757.071,+LEXIEN,0)),"^",3)
SET LEXINC=$PIECE($GET(^LEX(757.071,+LEXIEN,0)),"^",4)
+6 IF $DATA(LEXCAP)
WRITE !,LEXKEY,"~",LEXINC,"~",$SELECT(LEXEFF?7N:$$FMTE^XLFDT(LEXEFF,"5Z"),1:""),"~",$SELECT(LEXINA?7N:$$FMTE^XLFDT(LEXINA,"5Z"),1:""),"|"
QUIT
+7 WRITE !,LEXKEY
if $LENGTH($GET(LEXINC))
WRITE ?LEXC," ",LEXINC
+8 WRITE !,?LEXC," Effective:",?(LEXC+12)," ",$$FMTE^XLFDT(LEXEFF,"5Z")
+9 if $LENGTH(LEXINA)
WRITE ?(LEXC+24)," Inactive:",(LEXC+35)," ",$$FMTE^XLFDT(LEXINA,"5Z")
+10 WRITE !
End DoDot:2
End DoDot:1
+11 KILL LEXAFT
+12 QUIT
INA(X) ; Inactive before Today or after LEXAFT (optional)
+1 NEW LEXI,LEX1,LEX2,LEXA,LEXT,LEXO
SET LEXT=$$DT^XLFDT
SET LEXI=+($GET(X))
SET LEX1=+($PIECE($PIECE($GET(^LEX(757.071,+LEXI,0)),"^",2),".",1))
if LEX1'?7N
QUIT "0^1"
+2 SET LEX2=+($PIECE($PIECE($GET(^LEX(757.071,+LEXI,0)),"^",3),".",1))
if LEX2'?7N
QUIT "0^2"
SET LEXA=$GET(LEXAFT)
SET LEXO=0
+3 ; If Inactive after LEXAFT and not later Active 1
+4 if ($GET(LEXA)?7N)&((LEX2+.001)>LEXA)&((LEX2+.001)>LEX1)
QUIT "1^3"
+5 ; If Inactive after LEXAFT and later Active 0
+6 if ($GET(LEXA)?7N)&((LEX2+.001)>LEXA)&((LEX1+.001)>LEX2)
QUIT "0^4"
+7 ; If Inactive before LEXAFT and not later Active 0
+8 if ($GET(LEXA)?7N)&((LEXA+.001)>LEX2)&((LEX2+.001)>LEX1)
QUIT "0^5"
+9 ; If Inactive 1
+10 if (LEX2+.001)>LEX1
QUIT "1^6"
+11 ; Else Active 0
+12 QUIT "0^7"
ACT(X) ; Active before Today or after LEXAFT (optional)
+1 NEW LEXI,LEX1,LEX2,LEXA,LEXT,LEXO
SET LEXT=$$DT^XLFDT
SET LEXI=+($GET(X))
SET LEX1=+($PIECE($PIECE($GET(^LEX(757.071,+LEXI,0)),"^",2),".",1))
if LEX1'?7N
QUIT "0^1"
+2 SET LEX2=+($PIECE($PIECE($GET(^LEX(757.071,+LEXI,0)),"^",3),".",1))
SET LEXA=$GET(LEXAFT)
SET LEXO=0
+3 ; If Active after LEXAFT and not later Inctive 1
+4 if ($GET(LEXA)?7N)&((LEX1+.001)>LEXA)&((LEX1+.001)>LEX2)
QUIT "1^2"
+5 ; If Active after LEXAFT and later Inactive 0
+6 if ($GET(LEXA)?7N)&((LEX1+.001)>LEXA)&((LEX2+.001)>LEX1)
QUIT "0^3"
+7 ; If Active before LEXAFT and not later Inactive 0
+8 if ($GET(LEXA)?7N)&((LEXA+.001)>LEX1)&((LEX1+.001)>LEX2)
QUIT "0^4"
+9 ; If Active 1
+10 if (LEX1+.001)>LEX2
QUIT "1^5"
+11 ; Else Inactive 0
+12 QUIT "0^6"
OUT(X) ; Output
+1 if $DATA(LEXQUIET)
QUIT 0
if $DATA(ZTQUEUED)
QUIT 0
+2 QUIT 1
TM(X,Y) ; Trim Spaces
+1 SET X=$GET(X)
if X=""
QUIT X
SET Y=$EXTRACT($GET(Y),1)
if '$LENGTH(Y)
SET Y=" "
FOR
if $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 FOR
if $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+3 QUIT X
ZERO ; ^LEX(757.071,0)
+1 NEW LEXIEN,LEXP1,LEXP2,LEXP3,LEXP4
SET (LEXIEN,LEXP3,LEXP4)=0
SET LEXP1=$PIECE($GET(^LEX(757.071,0)),"^",1)
SET LEXP2=$PIECE($GET(^LEX(757.071,0)),"^",2)
+2 if '$LENGTH(LEXP1)
QUIT
if '$LENGTH(LEXP2)
QUIT
if LEXP2'["757.071"
QUIT
FOR
SET LEXIEN=$ORDER(^LEX(757.071,LEXIEN))
if +LEXIEN'>0
QUIT
SET LEXP4=LEXP4+1
+3 SET LEXP3=$ORDER(^LEX(757.071," "),-1)
if LEXP3'>0
SET LEXP3=""
if LEXP4>0
SET ^LEX(757.071,0)=LEXP1_"^"_LEXP2_"^"_LEXP3_"^"_LEXP4
+4 QUIT
PAUSE(X) ; Pause Monitor
+1 NEW LEXCONT,LEXPMT
SET LEXPMT=" Press <Return> to continue or ""^"" to exit "
WRITE !!,LEXPMT
READ LEXCONT:2
if LEXCONT["^"
QUIT "^"
+2 QUIT ""
CONT ; Continue
+1 NEW LEXCONT,LEXPMT
IF IOST["P-"
USE IO
if $LENGTH($GET(IOF))
WRITE @IOF
QUIT
+2 SET LEXPMT=" Press <Return> to continue "
if $LENGTH($GET(LEXDIRA))
SET LEXPMT=LEXDIRA
+3 if '$LENGTH($GET(LEXDIRA))
WRITE !
WRITE !,LEXPMT
READ LEXCONT:660
NEW LEXDIRA
+4 IF '$TEST!(LEXCONT["^")
if $LENGTH($GET(IOF))
WRITE @IOF
KILL LEXCONT
SET LEXIT=1
QUIT
+5 if $LENGTH($GET(IOF))
WRITE @IOF
+6 QUIT
ENV(X) ; Environment
+1 DO HOME^%ZIS
SET U="^"
SET DT=$$DT^XLFDT
SET DTIME=300
KILL POP
+2 NEW LEXNM
SET LEXNM=$$GET1^DIQ(200,(DUZ_","),.01)
+3 IF '$LENGTH(LEXNM)
WRITE !!,?5,"Invalid/Missing DUZ"
NEW LEXCAP,LEXCHK,LEXONE
QUIT 0
+4 QUIT 1
