LEXRXC3 ;ISL/KER - Re-Index 757.01 ASL/APAR ;08/17/2011
;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 10
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEX(757.01, SACC 1.3
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
;
; Local Variables NEWed or KILLed Elsewhere
; LEXNAM Task name NEWed/KILLed by LEXRXXT
; LEXTEST Test variable NEWed/KILLed by Developer
; ZTQUEUED Task flag NEWed/KILLed by Taskman
;
Q
EN ; Main Entry Point
R75701 ; Repair file 757.01
D RASL,RAPAR Q
RASL ; Index ^LEX(757.01,"ASL",STR,FREQ)
N LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXNDS,LEXPSCT,LEXSCT,LEXSTR,LEXTC,LEXTNG
S LEXFI="757.01"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""ASL""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="ASL",LEXIDXT="^LEX(757.01,""ASL"",STR,FREQ)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. S LEXNDS=LEXNDS+1
. S LEXSCT=$$SCT^LEXRXC3(LEXSTR)
. S LEXPSCT=$O(^LEX(LEXFI,LEXIDX,LEXSTR,0))
. I +LEXPSCT>0,+LEXSCT'>0 D
. . K ^LEX(LEXFI,LEXIDX,LEXSTR,+LEXPSCT)
. . I $D(LEXTEST),'$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted) ",LEXSTR
. I +LEXPSCT>0,+LEXSCT>0,+LEXPSCT'=LEXSCT D
. . K ^LEX(LEXFI,LEXIDX,LEXSTR,+LEXPSCT) S ^LEX(LEXFI,LEXIDX,LEXSTR,+LEXSCT)=""
. . I $D(LEXTEST),'$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Re-Calculated ",LEXSTR
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
RAPAR ; Index ^LEX(757.01,"APAR",MC,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXPAR,LEXPR,LEXSTR
S LEXFI="757.01"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""APAR""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="APAR",LEXIDXT="^LEX(757.01,""APAR"",PARENT,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 N LEXOK,LEXPR S LEXPR=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",9))
. . S LEXOK=0 S:LEXPR=LEXSTR LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:+LEXPR>0 ^LEX(LEXFI,LEXIDX,+LEXPR,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,LEXPAR S DA=LEXIEN S LEXPAR=$P($G(^LEX(757.01,DA,1)),"^",9) Q:'$L(LEXPAR)
. I '$D(^LEX(757.01,LEXIDX,$E(LEXPAR,1,30),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
. S:$L(LEXPAR) ^LEX(757.01,LEXIDX,$E(LEXPAR,1,30),DA)=""
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
SCT(X) ; String Counter
N LEXC,LEXW,LEXO,LEXT
S (LEXC,LEXW)=$$UP^XLFSTR($G(X)),LEXT=0 Q:'$L(LEXW) 0
S:$L(LEXW)>1 LEXO=$E(LEXW,1,($L(LEXW)-1))_$C(($A($E(LEXW,$L(LEXW)))-1))_"~"
S:$L(LEXW)=1 LEXO=$C(($A(LEXW)-1))_"~"
F S LEXO=$O(^LEX(757.01,"AWRD",LEXO)) Q:'$L(LEXO) Q:$E(LEXO,1,$L(LEXC))'=LEXC D
. N LEXM S LEXM=0 F S LEXM=$O(^LEX(757.01,"AWRD",LEXO,LEXM)) Q:+LEXM'>0 D
. . N LEXE S LEXE=0 F S LEXE=$O(^LEX(757.01,"AWRD",LEXO,LEXM,LEXE)) Q:+LEXE'>0 D
. . . S LEXT=LEXT+1
S X=LEXT
Q X
CLR ; Clear
K LEXNAM,LEXTEST,ZTQUEUED
Q
LEXRXC3 ;ISL/KER - Re-Index 757.01 ASL/APAR ;08/17/2011
+1 ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^LEX( SACC 1.3
+5 ; ^LEX(757.01, SACC 1.3
+6 ;
+7 ; External References
+8 ; $$FMDIFF^XLFDT ICR 10103
+9 ; $$NOW^XLFDT ICR 10103
+10 ; $$UP^XLFSTR ICR 10104
+11 ;
+12 ; Local Variables NEWed or KILLed Elsewhere
+13 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+14 ; LEXTEST Test variable NEWed/KILLed by Developer
+15 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+16 ;
+17 QUIT
EN ; Main Entry Point
R75701 ; Repair file 757.01
+1 DO RASL
DO RAPAR
QUIT
RASL ; Index ^LEX(757.01,"ASL",STR,FREQ)
+1 NEW LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXNDS,LEXPSCT,LEXSCT,LEXSTR,LEXTC,LEXTNG
+2 SET LEXFI="757.01"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.01 ""ASL""")
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.01
SET LEXIDX="ASL"
SET LEXIDXT="^LEX(757.01,""ASL"",STR,FREQ)"
+5 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+6 SET LEXNDS=LEXNDS+1
+7 SET LEXSCT=$$SCT^LEXRXC3(LEXSTR)
+8 SET LEXPSCT=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,0))
+9 IF +LEXPSCT>0
IF +LEXSCT'>0
Begin DoDot:2
+10 KILL ^LEX(LEXFI,LEXIDX,LEXSTR,+LEXPSCT)
+11 IF $DATA(LEXTEST)
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted) ",LEXSTR
End DoDot:2
+12 IF +LEXPSCT>0
IF +LEXSCT>0
IF +LEXPSCT'=LEXSCT
Begin DoDot:2
+13 KILL ^LEX(LEXFI,LEXIDX,LEXSTR,+LEXPSCT)
SET ^LEX(LEXFI,LEXIDX,LEXSTR,+LEXSCT)=""
+14 IF $DATA(LEXTEST)
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Re-Calculated ",LEXSTR
End DoDot:2
End DoDot:1
+15 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
+16 IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+17 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+18 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+19 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+20 QUIT
RAPAR ; Index ^LEX(757.01,"APAR",MC,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXPAR,LEXPR,LEXSTR
+2 SET LEXFI="757.01"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.01 ""APAR""")
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.01
SET LEXIDX="APAR"
SET LEXIDXT="^LEX(757.01,""APAR"",PARENT,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
NEW LEXOK,LEXPR
SET LEXPR=+($PIECE($GET(^LEX(LEXFI,LEXIEN,1)),"^",9))
+8 SET LEXOK=0
IF LEXPR=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+9 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
IF +LEXPR>0
SET ^LEX(LEXFI,LEXIDX,+LEXPR,LEXIEN)=""
+10 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
End DoDot:2
End DoDot:1
+11 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+12 NEW DA,LEXPAR
SET DA=LEXIEN
SET LEXPAR=$PIECE($GET(^LEX(757.01,DA,1)),"^",9)
IF '$LENGTH(LEXPAR)
QUIT
+13 IF '$DATA(^LEX(757.01,LEXIDX,$EXTRACT(LEXPAR,1,30),DA))
Begin DoDot:2
+14 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
End DoDot:2
+15 IF $LENGTH(LEXPAR)
SET ^LEX(757.01,LEXIDX,$EXTRACT(LEXPAR,1,30),DA)=""
End DoDot:1
+16 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+17 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+18 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+19 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+20 QUIT
+21 ;
+22 ; Miscellaneous
SCT(X) ; String Counter
+1 NEW LEXC,LEXW,LEXO,LEXT
+2 SET (LEXC,LEXW)=$$UP^XLFSTR($GET(X))
SET LEXT=0
IF '$LENGTH(LEXW)
QUIT 0
+3 IF $LENGTH(LEXW)>1
SET LEXO=$EXTRACT(LEXW,1,($LENGTH(LEXW)-1))_$CHAR(($ASCII($EXTRACT(LEXW,$LENGTH(LEXW)))-1))_"~"
+4 IF $LENGTH(LEXW)=1
SET LEXO=$CHAR(($ASCII(LEXW)-1))_"~"
+5 FOR
SET LEXO=$ORDER(^LEX(757.01,"AWRD",LEXO))
IF '$LENGTH(LEXO)
QUIT
IF $EXTRACT(LEXO,1,$LENGTH(LEXC))'=LEXC
QUIT
Begin DoDot:1
+6 NEW LEXM
SET LEXM=0
FOR
SET LEXM=$ORDER(^LEX(757.01,"AWRD",LEXO,LEXM))
IF +LEXM'>0
QUIT
Begin DoDot:2
+7 NEW LEXE
SET LEXE=0
FOR
SET LEXE=$ORDER(^LEX(757.01,"AWRD",LEXO,LEXM,LEXE))
IF +LEXE'>0
QUIT
Begin DoDot:3
+8 SET LEXT=LEXT+1
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET X=LEXT
+10 QUIT X
CLR ; Clear
+1 KILL LEXNAM,LEXTEST,ZTQUEUED
+2 QUIT
