- LEXRXXM2 ;ISL/KER - Re-Index Miscellaneous (cont) ;08/17/2011
- ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 10
- ;
- ; 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
- LEXRXXM2 ;ISL/KER - Re-Index Miscellaneous (cont) ;08/17/2011
- +1 ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 10
- +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
