LEXRXXM2 ;ISL/KER - Re-Index Miscellaneous (cont) ;08/17/2011
;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXRX") SACC 2.3.2.5.1
; ^XTMP("LEXRX") SACC 2.3.2.5.2
;
; Special Variables
; DTIME SACC 2.3.1.5.3
;
; External References
; KILL^%ZTLOAD ICR 10063
; STAT^%ZTLOAD ICR 10063
; ^DIR ICR 10026
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
;
Q
; Miscellaneous
CHECK(X) ; Check for Running
; Input
; None
; Output
; 0 Task is not Running
; 1 Task is Running
N LEXIS,LEXII,LEXC,LEXCHK S LEXCHK="",LEXIS=$$IS,LEXII=$$II
I +LEXIS>0,+LEXII>0 D Q
. N LEXMSG S LEXMSG=$P(LEXII,"^",2)
. W:$L(LEXMSG) !," ",LEXMSG
Q:+LEXIS'>0 0 S LEXC=$$PROG^LEXRXXM2 W !
Q 1
MON ; Monitor Status of Re-Index
N LEXC,LEXMON,LEXEXIT,LEXHT,LEXIS,LEXII,LEXNOW S LEXMON=0
S LEXIS=$$IS,LEXII=$$II I +LEXIS'>0 D Q
. W !," Lexicon cross-reference repair is not running"
I +LEXIS>0,+LEXII>0 D Q
. N LEXMSG S LEXMSG=$P(LEXII,"^",2)
. W:$L(LEXMSG) !," ",LEXMSG
W !!," Entering an Up-Arrow ""^"" to exit"
S (LEXMON,LEXEXIT)=0
F D Q:+LEXEXIT>0
. N LEXC S LEXEXIT=$$PA(5) S LEXMON=LEXMON+1
. S LEXC=$$PROG^LEXRXXM2 S:LEXC'>0 LEXEXIT=1
S LEXNOW=$$IS I +($G(LEXIS))>0,+($G(LEXNOW))'>0 D
. W !!," Lexicon cross-reference repair/re-index completed",!
. S LEXEXIT=$$PA(1)
Q
PA(X) ; Pause
N DTIME,DIR,DTOUT,DUOUT,DIRUT,DIROUT,LEXHT,Y S LEXHT=+($G(X))
S:+LEXHT'>0 LEXHT=2 S DTIME=LEXHT
S DIR(0)="FAO",(DIR("?"),DIR("??"))="",DIR("A")=""
S DIR("PRE")="S:X[""?"" X=""^""" D ^DIR
S:$D(DUOUT)!($D(DIROUT)) X="^" S:X'["^" X=0 S:X["^" X=1
Q X
IS(X) ; Task is Running
N LEXO,LEXTSK,ZTSK,LEXMSG S LEXO="LEXRW~",LEXMSG=""
F S LEXO=$O(^XTMP(LEXO)) Q:'$L(LEXO)!($E(LEXO,1,5)'="LEXRX") D
. S LEXTSK=$G(^XTMP(LEXO,1)) Q:+LEXTSK'>0 N ZTSK S ZTSK=+LEXTSK
. D STAT^%ZTLOAD Q:+($G(ZTSK(0)))'>0
. I +($G(ZTSK(1)))>2,+($G(ZTSK(1)))'=5 D Q
. . N ZTSK S ZTSK=+LEXTSK
. . D:+($G(ZTSK(1)))'=5 KILL^%ZTLOAD
. . K ^XTMP(LEXO)
. S X=+($G(X))+1
S X=+($G(X))
Q X
II(X) ; Inactive and Interrupted
N LEXO,LEXTSK,ZTSK,LEXMSG S LEXO="LEXRW~",LEXMSG=""
F S LEXO=$O(^XTMP(LEXO)) Q:'$L(LEXO)!($E(LEXO,1,5)'="LEXRX") D Q:$L(LEXMSG)
. S LEXTSK=$G(^XTMP(LEXO,1)) Q:+LEXTSK'>0
. N ZTSK S ZTSK=+LEXTSK
. D STAT^%ZTLOAD Q:+($G(ZTSK(0)))'>0
. S:+($G(ZTSK(1)))=5 LEXMSG="1^Task "_ZTSK_" was interrupted and is inactive"
S X=$G(LEXMSG) S:'$L(X) X=0
Q X
PROG(X) ; Progress
N LEXBEG,LEXBEGE,LEXBEGD,LEXUPD,LEXNAM,LEXO,LEXUPDE,LEXUPDD,LEXDES
N LEXACT,LEXCUR,LEXTASK,LEXTSK,LEXNOW,LEXND S X=0
S LEXO="LEXRW~" K LEXTASK
F S LEXO=$O(^XTMP(LEXO)) Q:'$L(LEXO)!($E(LEXO,1,5)'="LEXRX") D
. S LEXNAM=LEXO,LEXTSK=$G(^XTMP(LEXNAM,1))
. Q:+LEXTSK'>0 N ZTSK S ZTSK=+LEXTSK
. D STAT^%ZTLOAD Q:+($G(ZTSK(0)))'>0
. I +($G(ZTSK(1)))>2 D Q
. . N ZTSK S ZTSK=+LEXTSK
. . D KILL^%ZTLOAD K ^XTMP(LEXNAM)
. S LEXNOW=$$NOW^XLFDT,LEXND=$G(^XTMP(LEXNAM,0))
. S LEXBEG=$P(LEXND,"^",3),LEXDES=$P(LEXND,"^",4)
. Q:'$L(LEXDES)
. S LEXTSK=$G(^XTMP(LEXNAM,1)),LEXND=$G(^XTMP(LEXNAM,2))
. S LEXUPD=$P(LEXND,"^",1),LEXACT=$P(LEXND,"^",2)
. S LEXBEGE=$$ED^LEXRXXM(LEXBEG),LEXUPDE=$$ED^LEXRXXM(LEXUPD)
. S LEXBEGD=$$FMDIFF^XLFDT(LEXNOW,LEXBEG,3)
. S LEXUPDD=$$FMDIFF^XLFDT(LEXNOW,LEXBEG,3)
. S:$E(LEXBEGD,1)=" "&($E(LEXBEGD,3)=":") LEXBEGD=$TR(LEXBEGD," ","0")
. S:$E(LEXUPDD,1)=" "&($E(LEXUPDD,3)=":") LEXUPDD=$TR(LEXUPDD," ","0")
. W:$L($G(IOF))&('$D(LEXCHK)) @IOF I +($G(ZTSK(1)))=1 D Q
. . W !!," ",LEXDES
. . W !," The task is scheduled, waiting for an I/O device, a volume"
. . W !," set link, or a partition in memory" S X=+($G(X))+1
. I +($G(ZTSK(1)))=2 D Q
. . W !!," Repair/Re-Index is in progress" S X=+($G(X))+1
. . W !,?3,LEXDES W:$L(LEXBEGE) ?49,"Started: ",LEXBEGE
. . I $L(LEXACT) D
. . . W !,?5,LEXACT
. . . W:$L(LEXUPDE) ?49,"Current: ",LEXUPDE
. . W:$L(LEXBEGD)&(+($G(LEXMON))'>0) !,?49,"Running: ",LEXBEGD
. . W:$L(LEXBEGD)&(+($G(LEXMON))>0) !,?7,"#",+($G(LEXMON)),?49,"Running: ",LEXBEGD
S X=+($G(X))
Q X
CLR ; Clear
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXXM2 4282 printed Dec 13, 2024@02:09:29 Page 2
LEXRXXM2 ;ISL/KER - Re-Index Miscellaneous (cont) ;08/17/2011
+1 ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXRX") SACC 2.3.2.5.1
+5 ; ^XTMP("LEXRX") SACC 2.3.2.5.2
+6 ;
+7 ; Special Variables
+8 ; DTIME SACC 2.3.1.5.3
+9 ;
+10 ; External References
+11 ; KILL^%ZTLOAD ICR 10063
+12 ; STAT^%ZTLOAD ICR 10063
+13 ; ^DIR ICR 10026
+14 ; $$FMDIFF^XLFDT ICR 10103
+15 ; $$NOW^XLFDT ICR 10103
+16 ;
+17 QUIT
+18 ; Miscellaneous
CHECK(X) ; Check for Running
+1 ; Input
+2 ; None
+3 ; Output
+4 ; 0 Task is not Running
+5 ; 1 Task is Running
+6 NEW LEXIS,LEXII,LEXC,LEXCHK
SET LEXCHK=""
SET LEXIS=$$IS
SET LEXII=$$II
+7 IF +LEXIS>0
IF +LEXII>0
Begin DoDot:1
+8 NEW LEXMSG
SET LEXMSG=$PIECE(LEXII,"^",2)
+9 if $LENGTH(LEXMSG)
WRITE !," ",LEXMSG
End DoDot:1
QUIT
+10 if +LEXIS'>0
QUIT 0
SET LEXC=$$PROG^LEXRXXM2
WRITE !
+11 QUIT 1
MON ; Monitor Status of Re-Index
+1 NEW LEXC,LEXMON,LEXEXIT,LEXHT,LEXIS,LEXII,LEXNOW
SET LEXMON=0
+2 SET LEXIS=$$IS
SET LEXII=$$II
IF +LEXIS'>0
Begin DoDot:1
+3 WRITE !," Lexicon cross-reference repair is not running"
End DoDot:1
QUIT
+4 IF +LEXIS>0
IF +LEXII>0
Begin DoDot:1
+5 NEW LEXMSG
SET LEXMSG=$PIECE(LEXII,"^",2)
+6 if $LENGTH(LEXMSG)
WRITE !," ",LEXMSG
End DoDot:1
QUIT
+7 WRITE !!," Entering an Up-Arrow ""^"" to exit"
+8 SET (LEXMON,LEXEXIT)=0
+9 FOR
Begin DoDot:1
+10 NEW LEXC
SET LEXEXIT=$$PA(5)
SET LEXMON=LEXMON+1
+11 SET LEXC=$$PROG^LEXRXXM2
if LEXC'>0
SET LEXEXIT=1
End DoDot:1
if +LEXEXIT>0
QUIT
+12 SET LEXNOW=$$IS
IF +($GET(LEXIS))>0
IF +($GET(LEXNOW))'>0
Begin DoDot:1
+13 WRITE !!," Lexicon cross-reference repair/re-index completed",!
+14 SET LEXEXIT=$$PA(1)
End DoDot:1
+15 QUIT
PA(X) ; Pause
+1 NEW DTIME,DIR,DTOUT,DUOUT,DIRUT,DIROUT,LEXHT,Y
SET LEXHT=+($GET(X))
+2 if +LEXHT'>0
SET LEXHT=2
SET DTIME=LEXHT
+3 SET DIR(0)="FAO"
SET (DIR("?"),DIR("??"))=""
SET DIR("A")=""
+4 SET DIR("PRE")="S:X[""?"" X=""^"""
DO ^DIR
+5 if $DATA(DUOUT)!($DATA(DIROUT))
SET X="^"
if X'["^"
SET X=0
if X["^"
SET X=1
+6 QUIT X
IS(X) ; Task is Running
+1 NEW LEXO,LEXTSK,ZTSK,LEXMSG
SET LEXO="LEXRW~"
SET LEXMSG=""
+2 FOR
SET LEXO=$ORDER(^XTMP(LEXO))
if '$LENGTH(LEXO)!($EXTRACT(LEXO,1,5)'="LEXRX")
QUIT
Begin DoDot:1
+3 SET LEXTSK=$GET(^XTMP(LEXO,1))
if +LEXTSK'>0
QUIT
NEW ZTSK
SET ZTSK=+LEXTSK
+4 DO STAT^%ZTLOAD
if +($GET(ZTSK(0)))'>0
QUIT
+5 IF +($GET(ZTSK(1)))>2
IF +($GET(ZTSK(1)))'=5
Begin DoDot:2
+6 NEW ZTSK
SET ZTSK=+LEXTSK
+7 if +($GET(ZTSK(1)))'=5
DO KILL^%ZTLOAD
+8 KILL ^XTMP(LEXO)
End DoDot:2
QUIT
+9 SET X=+($GET(X))+1
End DoDot:1
+10 SET X=+($GET(X))
+11 QUIT X
II(X) ; Inactive and Interrupted
+1 NEW LEXO,LEXTSK,ZTSK,LEXMSG
SET LEXO="LEXRW~"
SET LEXMSG=""
+2 FOR
SET LEXO=$ORDER(^XTMP(LEXO))
if '$LENGTH(LEXO)!($EXTRACT(LEXO,1,5)'="LEXRX")
QUIT
Begin DoDot:1
+3 SET LEXTSK=$GET(^XTMP(LEXO,1))
if +LEXTSK'>0
QUIT
+4 NEW ZTSK
SET ZTSK=+LEXTSK
+5 DO STAT^%ZTLOAD
if +($GET(ZTSK(0)))'>0
QUIT
+6 if +($GET(ZTSK(1)))=5
SET LEXMSG="1^Task "_ZTSK_" was interrupted and is inactive"
End DoDot:1
if $LENGTH(LEXMSG)
QUIT
+7 SET X=$GET(LEXMSG)
if '$LENGTH(X)
SET X=0
+8 QUIT X
PROG(X) ; Progress
+1 NEW LEXBEG,LEXBEGE,LEXBEGD,LEXUPD,LEXNAM,LEXO,LEXUPDE,LEXUPDD,LEXDES
+2 NEW LEXACT,LEXCUR,LEXTASK,LEXTSK,LEXNOW,LEXND
SET X=0
+3 SET LEXO="LEXRW~"
KILL LEXTASK
+4 FOR
SET LEXO=$ORDER(^XTMP(LEXO))
if '$LENGTH(LEXO)!($EXTRACT(LEXO,1,5)'="LEXRX")
QUIT
Begin DoDot:1
+5 SET LEXNAM=LEXO
SET LEXTSK=$GET(^XTMP(LEXNAM,1))
+6 if +LEXTSK'>0
QUIT
NEW ZTSK
SET ZTSK=+LEXTSK
+7 DO STAT^%ZTLOAD
if +($GET(ZTSK(0)))'>0
QUIT
+8 IF +($GET(ZTSK(1)))>2
Begin DoDot:2
+9 NEW ZTSK
SET ZTSK=+LEXTSK
+10 DO KILL^%ZTLOAD
KILL ^XTMP(LEXNAM)
End DoDot:2
QUIT
+11 SET LEXNOW=$$NOW^XLFDT
SET LEXND=$GET(^XTMP(LEXNAM,0))
+12 SET LEXBEG=$PIECE(LEXND,"^",3)
SET LEXDES=$PIECE(LEXND,"^",4)
+13 if '$LENGTH(LEXDES)
QUIT
+14 SET LEXTSK=$GET(^XTMP(LEXNAM,1))
SET LEXND=$GET(^XTMP(LEXNAM,2))
+15 SET LEXUPD=$PIECE(LEXND,"^",1)
SET LEXACT=$PIECE(LEXND,"^",2)
+16 SET LEXBEGE=$$ED^LEXRXXM(LEXBEG)
SET LEXUPDE=$$ED^LEXRXXM(LEXUPD)
+17 SET LEXBEGD=$$FMDIFF^XLFDT(LEXNOW,LEXBEG,3)
+18 SET LEXUPDD=$$FMDIFF^XLFDT(LEXNOW,LEXBEG,3)
+19 if $EXTRACT(LEXBEGD,1)=" "&($EXTRACT(LEXBEGD,3)="
SET LEXBEGD=$TRANSLATE(LEXBEGD," ","0")
+20 if $EXTRACT(LEXUPDD,1)=" "&($EXTRACT(LEXUPDD,3)="
SET LEXUPDD=$TRANSLATE(LEXUPDD," ","0")
+21 if $LENGTH($GET(IOF))&('$DATA(LEXCHK))
WRITE @IOF
IF +($GET(ZTSK(1)))=1
Begin DoDot:2
+22 WRITE !!," ",LEXDES
+23 WRITE !," The task is scheduled, waiting for an I/O device, a volume"
+24 WRITE !," set link, or a partition in memory"
SET X=+($GET(X))+1
End DoDot:2
QUIT
+25 IF +($GET(ZTSK(1)))=2
Begin DoDot:2
+26 WRITE !!," Repair/Re-Index is in progress"
SET X=+($GET(X))+1
+27 WRITE !,?3,LEXDES
if $LENGTH(LEXBEGE)
WRITE ?49,"Started: ",LEXBEGE
+28 IF $LENGTH(LEXACT)
Begin DoDot:3
+29 WRITE !,?5,LEXACT
+30 if $LENGTH(LEXUPDE)
WRITE ?49,"Current: ",LEXUPDE
End DoDot:3
+31 if $LENGTH(LEXBEGD)&(+($GET(LEXMON))'>0)
WRITE !,?49,"Running: ",LEXBEGD
+32 if $LENGTH(LEXBEGD)&(+($GET(LEXMON))>0)
WRITE !,?7,"#",+($GET(LEXMON)),?49,"Running: ",LEXBEGD
End DoDot:2
QUIT
End DoDot:1
+33 SET X=+($GET(X))
+34 QUIT X
CLR ; Clear
+1 QUIT
