LEXRXA ;ISL/KER - Re-Index 757 B ;05/23/2017
;;2.0;LEXICON UTILITY;**81,103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^LEX(757, SACC 1.3
; ^LEX(757.001, SACC 1.3
; ^TMP("LEXRX") SACC 2.3.2.5.1
;
; External References
; FILE^DID ICR 2052
; IX1^DIK ICR 10013
; IXALL^DIK ICR 10013
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
;
; Local Variables NEWed or KILLed Elsewhere
; LEXNAM Task name NEWed/KILLed by LEXRXXT
; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
; LEXTEST Test variable NEWed/KILLed by Developer
; ZTQUEUED Task flag NEWed/KILLed by Taskman
;
Q
EN ; Main Entry Point
R757 ; Repair file 757
D RB,SET Q
RB ; Index ^LEX(757,"B",EXP,IEN)
W:'$D(ZTQUEUED) ! N DA,DIK,LEXBEG,LEXDIF,LEXTC,LEXELP,LEXEND,LEXERR,LEXFI,LEXFQ,LEXIDX
N LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR,X S LEXFI=757
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757 ""B""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXIDX="B",LEXIDXT="^LEX(757,""B"",MC,IEN)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
. . S LEXNDS=LEXNDS+1
. . I '$D(^LEX(LEXFI,LEXIEN,0)) D Q
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
. . N LEXOK,LEXMC S LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
. . S LEXOK=0 S:LEXMC=LEXSTR LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXMC) ^LEX(LEXFI,LEXIDX,LEXMC,LEXIEN)=""
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:'$L(X)
. I '$D(^LEX(LEXFI,"B",X,DA)) S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
. S ^LEX(LEXFI,"B",X,DA)="" I '$D(^LEX(757.001,DA)) D
. . N LEXFQ,DIK S LEXFQ=+($$FREQ^LEXRXXM(DA)) S ^LEX(757.001,DA,0)=DA_"^"_LEXFQ_"^"_LEXFQ
. . S DIK="^LEX(757.001," D IX1^DIK
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
Q
;
; Miscellaneous
SET ; Re-Index Major Concept Map file 757 (Set logic only)
Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
N LEXOUT,LEXMSG S LEXFI=757
D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX"
S LEXPRE=$G(^TMP("LEXRX",$J,"T",1,"ELAP"))
S LEXBEG=$$NOW^XLFDT,LEXNM=$$FN^LEXRXXM(LEXFI)
S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI))
Q:LEXTC=1 I '$D(ZTQUEUED) W !,?8,"Re-Indexing",!
N LEXIEN,LEXP3,LEXP4 S (LEXP3,LEXP4,LEXIEN)=0
F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 S LEXP3=LEXIEN,LEXP4=LEXP4+1
S:LEXP3>0 $P(^LEX(LEXFI,0),"^",3)=LEXP3 S:LEXP4>0 $P(^LEX(LEXFI,0),"^",4)=LEXP4
I +($G(LEXP4))>0 D
. N ZTQUEUED,DIK S ZTQUEUED=$G(ZTQUEUED) S DIK="^LEX(757.21," D IXALL^DIK
Q:$D(LEXQ) S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
S LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
S ^TMP("LEXRX",$J,"T",1,"ELAP")=LEXELP
Q
CLR ; Clear
K LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXA 3874 printed Dec 13, 2024@02:09:10 Page 2
LEXRXA ;ISL/KER - Re-Index 757 B ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**81,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^LEX(757, SACC 1.3
+5 ; ^LEX(757.001, SACC 1.3
+6 ; ^TMP("LEXRX") SACC 2.3.2.5.1
+7 ;
+8 ; External References
+9 ; FILE^DID ICR 2052
+10 ; IX1^DIK ICR 10013
+11 ; IXALL^DIK ICR 10013
+12 ; $$FMDIFF^XLFDT ICR 10103
+13 ; $$NOW^XLFDT ICR 10103
+14 ;
+15 ; Local Variables NEWed or KILLed Elsewhere
+16 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+17 ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
+18 ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
+19 ; LEXTEST Test variable NEWed/KILLed by Developer
+20 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+21 ;
+22 QUIT
EN ; Main Entry Point
R757 ; Repair file 757
+1 DO RB
DO SET
QUIT
RB ; Index ^LEX(757,"B",EXP,IEN)
+1 if '$DATA(ZTQUEUED)
WRITE !
NEW DA,DIK,LEXBEG,LEXDIF,LEXTC,LEXELP,LEXEND,LEXERR,LEXFI,LEXFQ,LEXIDX
+2 NEW LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR,X
SET LEXFI=757
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757 ""B""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXIDX="B"
SET LEXIDXT="^LEX(757,""B"",MC,IEN)"
+5 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+6 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:2
+7 SET LEXNDS=LEXNDS+1
+8 IF '$DATA(^LEX(LEXFI,LEXIEN,0))
Begin DoDot:3
+9 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
+10 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
QUIT
+11 NEW LEXOK,LEXMC
SET LEXMC=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",1)
+12 SET LEXOK=0
if LEXMC=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+13 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
if $LENGTH(LEXMC)
SET ^LEX(LEXFI,LEXIDX,LEXMC,LEXIEN)=""
+14 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
End DoDot:2
End DoDot:1
+15 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+16 NEW DA,X
SET DA=LEXIEN
SET X=$PIECE($GET(^LEX(LEXFI,DA,0)),"^",1)
if '$LENGTH(X)
QUIT
+17 IF '$DATA(^LEX(LEXFI,"B",X,DA))
SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
+18 SET ^LEX(LEXFI,"B",X,DA)=""
IF '$DATA(^LEX(757.001,DA))
Begin DoDot:2
+19 NEW LEXFQ,DIK
SET LEXFQ=+($$FREQ^LEXRXXM(DA))
SET ^LEX(757.001,DA,0)=DA_"^"_LEXFQ_"^"_LEXFQ
+20 SET DIK="^LEX(757.001,"
DO IX1^DIK
End DoDot:2
End DoDot:1
+21 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+22 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+23 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+24 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+25 QUIT
+26 ;
+27 ; Miscellaneous
SET ; Re-Index Major Concept Map file 757 (Set logic only)
+1 if '$DATA(LEXSET)
QUIT
NEW LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
+2 NEW LEXOUT,LEXMSG
SET LEXFI=757
+3 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
+4 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
if LEXRT'["^LEX"
QUIT
+5 SET LEXPRE=$GET(^TMP("LEXRX",$JOB,"T",1,"ELAP"))
+6 SET LEXBEG=$$NOW^XLFDT
SET LEXNM=$$FN^LEXRXXM(LEXFI)
+7 SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
+8 if LEXTC=1
QUIT
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing",!
+9 NEW LEXIEN,LEXP3,LEXP4
SET (LEXP3,LEXP4,LEXIEN)=0
+10 FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
SET LEXP3=LEXIEN
SET LEXP4=LEXP4+1
+11 if LEXP3>0
SET $PIECE(^LEX(LEXFI,0),"^",3)=LEXP3
if LEXP4>0
SET $PIECE(^LEX(LEXFI,0),"^",4)=LEXP4
+12 IF +($GET(LEXP4))>0
Begin DoDot:1
+13 NEW ZTQUEUED,DIK
SET ZTQUEUED=$GET(ZTQUEUED)
SET DIK="^LEX(757.21,"
DO IXALL^DIK
End DoDot:1
+14 if $DATA(LEXQ)
QUIT
SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+15 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+16 DO REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
+17 SET LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
+18 SET ^TMP("LEXRX",$JOB,"T",1,"ELAP")=LEXELP
+19 QUIT
CLR ; Clear
+1 KILL LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
+2 QUIT
