- 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
