LEXRXD2 ;ISL/KER - Re-Index 757.02 AMC/ASRC ;05/23/2017
;;2.0;LEXICON UTILITY;**81,103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEX(757.02, SACC 1.3
; ^LEX(757, SACC 1.3
; ^LEX(757.03, SACC 1.3
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
;
; 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
R75702 ; Repair file 757.02
D RAMC,RASRC Q
RAMC ; Index ^LEX(757.02,"AMC",MC,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXST
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""AMC""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXST="",LEXFI=757.01,LEXIDX="AMC",LEXIDXT="^LEX(757.02,""AMC"",MC,IEN)"
S LEXERR=0,LEXST="",LEXFI=757.02,LEXIDX="AMC"
F S LEXST=$O(^LEX(LEXFI,LEXIDX,LEXST)) Q:'$L(LEXST) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)) Q:+LEXIEN'>0 D
. . S LEXNDS=LEXNDS+1 N LEXOK,LEXMC S LEXMC=+($P($G(^LEX(LEXFI,LEXIEN,0)),"^",4))
. . S LEXOK=0 S:LEXMC=LEXST LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN) S:+LEXMC>0 ^LEX(LEXFI,LEXIDX,+LEXMC,LEXIEN)=""
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXST,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEXMC S DA=LEXIEN,LEXMC=+($P($G(^LEX(LEXFI,DA,0)),"^",4)) Q:LEXMC'>0 Q:'$D(^LEX(757,+LEXMC,0))
. I '$D(^LEX(LEXFI,LEXIDX,LEXMC,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,?58," ",DA
. S:$L(LEXMC) ^LEX(LEXFI,LEXIDX,LEXMC,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
RASRC ; Index ^LEX(757.02,"ASRC",SAB,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXST
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""ASRC""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXST="",LEXFI=757.02,LEXIDX="ASRC",LEXIDXT="^LEX(757.02,""ASRC"",SAB,IEN)"
F S LEXST=$O(^LEX(LEXFI,LEXIDX,LEXST)) Q:'$L(LEXST) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)) Q:+LEXIEN'>0 D
. . S LEXNDS=LEXNDS+1 N LEXOK,LEXSO,LEXSR,LEXSB S LEXSO=$P($G(^LEX(757.02,+LEXIEN,0)),"^",2)
. . S LEXSR=$P($G(^LEX(757.02,+LEXIEN,0)),"^",3),LEXSB=$E($P($G(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
. . I '$L(LEXSO)!($L(LEXSB)'=3) D Q
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXST,?58," ",LEXIEN
. . S LEXOK=0 S:LEXSB=LEXST LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
. . . S:$L(LEXSB) ^LEX(LEXFI,LEXIDX,LEXSB,LEXIEN)=""
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXST," ",$G(LEXSO),?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEXSO,LEXSR,LEXSB S DA=LEXIEN,LEXSR=$P($G(^LEX(LEXFI,+DA,0)),"^",3),LEXSO=$P($G(^LEX(757.02,DA,0)),U,2)
. S LEXSB=$E($P($G(^LEX(757.03,+LEXSR,0)),"^",1),1,3) Q:$L(LEXSB)'=3 Q:'$L(LEXSO)
. I '$D(^LEX(LEXFI,LEXIDX,LEXSB,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSB,"/",LEXSO,?58," ",DA
. S:$L(LEXSB) ^LEX(LEXFI,LEXIDX,LEXSB,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
CLR ; Clear
K LEXNAM,LEXTEST,ZTQUEUED
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXD2 4308 printed Apr 09, 2024@21:10:32 Page 2
LEXRXD2 ;ISL/KER - Re-Index 757.02 AMC/ASRC ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**81,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^LEX( SACC 1.3
+5 ; ^LEX(757.02, SACC 1.3
+6 ; ^LEX(757, SACC 1.3
+7 ; ^LEX(757.03, SACC 1.3
+8 ;
+9 ; External References
+10 ; $$FMDIFF^XLFDT ICR 10103
+11 ; $$NOW^XLFDT ICR 10103
+12 ;
+13 ; Local Variables NEWed or KILLed Elsewhere
+14 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+15 ; LEXTEST Test variable NEWed/KILLed by Developer
+16 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+17 ;
+18 QUIT
EN ; Main Entry Point
R75702 ; Repair file 757.02
+1 DO RAMC
DO RASRC
QUIT
RAMC ; Index ^LEX(757.02,"AMC",MC,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXST
+2 SET LEXFI="757.02"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""AMC""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXST=""
SET LEXFI=757.01
SET LEXIDX="AMC"
SET LEXIDXT="^LEX(757.02,""AMC"",MC,IEN)"
+5 SET LEXERR=0
SET LEXST=""
SET LEXFI=757.02
SET LEXIDX="AMC"
+6 FOR
SET LEXST=$ORDER(^LEX(LEXFI,LEXIDX,LEXST))
if '$LENGTH(LEXST)
QUIT
Begin DoDot:1
+7 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXST,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:2
+8 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEXMC
SET LEXMC=+($PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",4))
+9 SET LEXOK=0
if LEXMC=LEXST
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+10 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
if +LEXMC>0
SET ^LEX(LEXFI,LEXIDX,+LEXMC,LEXIEN)=""
+11 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXST,?58," ",LEXIEN
End DoDot:3
End DoDot:2
End DoDot:1
+12 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+13 NEW DA,DIK,LEXMC
SET DA=LEXIEN
SET LEXMC=+($PIECE($GET(^LEX(LEXFI,DA,0)),"^",4))
if LEXMC'>0
QUIT
if '$DATA(^LEX(757,+LEXMC,0))
QUIT
+14 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXMC,DA))
Begin DoDot:2
+15 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,?58," ",DA
End DoDot:2
+16 if $LENGTH(LEXMC)
SET ^LEX(LEXFI,LEXIDX,LEXMC,DA)=""
End DoDot:1
+17 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+18 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+19 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+20 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+21 QUIT
RASRC ; Index ^LEX(757.02,"ASRC",SAB,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXST
+2 SET LEXFI="757.02"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""ASRC""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXST=""
SET LEXFI=757.02
SET LEXIDX="ASRC"
SET LEXIDXT="^LEX(757.02,""ASRC"",SAB,IEN)"
+5 FOR
SET LEXST=$ORDER(^LEX(LEXFI,LEXIDX,LEXST))
if '$LENGTH(LEXST)
QUIT
Begin DoDot:1
+6 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXST,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:2
+7 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEXSO,LEXSR,LEXSB
SET LEXSO=$PIECE($GET(^LEX(757.02,+LEXIEN,0)),"^",2)
+8 SET LEXSR=$PIECE($GET(^LEX(757.02,+LEXIEN,0)),"^",3)
SET LEXSB=$EXTRACT($PIECE($GET(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
+9 IF '$LENGTH(LEXSO)!($LENGTH(LEXSB)'=3)
Begin DoDot:3
+10 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
+11 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXST,?58," ",LEXIEN
End DoDot:3
QUIT
+12 SET LEXOK=0
if LEXSB=LEXST
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+13 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
+14 if $LENGTH(LEXSB)
SET ^LEX(LEXFI,LEXIDX,LEXSB,LEXIEN)=""
+15 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXST," ",$GET(LEXSO),?58," ",LEXIEN
End DoDot:3
End DoDot:2
End DoDot:1
+16 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+17 NEW DA,DIK,LEXSO,LEXSR,LEXSB
SET DA=LEXIEN
SET LEXSR=$PIECE($GET(^LEX(LEXFI,+DA,0)),"^",3)
SET LEXSO=$PIECE($GET(^LEX(757.02,DA,0)),U,2)
+18 SET LEXSB=$EXTRACT($PIECE($GET(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
if $LENGTH(LEXSB)'=3
QUIT
if '$LENGTH(LEXSO)
QUIT
+19 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXSB,DA))
Begin DoDot:2
+20 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSB,"/",LEXSO,?58," ",DA
End DoDot:2
+21 if $LENGTH(LEXSB)
SET ^LEX(LEXFI,LEXIDX,LEXSB,DA)=""
End DoDot:1
+22 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+23 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+24 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+25 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+26 QUIT
+27 ;
+28 ; Miscellaneous
CLR ; Clear
+1 KILL LEXNAM,LEXTEST,ZTQUEUED
+2 QUIT
