LEXRXD3 ;ISL/KER - Re-Index 757.02 APCODE ;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 RAPCODE Q
RAPCODE ; Index ^LEX(757.02,"APCODE",CODE,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXPF,LEXSO,LEXST
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""APCODE""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXST="",LEXFI=757.02,LEXIDX="APCODE",LEXIDXT="^LEX(757.02,""APCODE"",CODE,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,LEXPF S LEXSO=$P($G(^LEX(757.02,LEXIEN,0)),U,2),LEXPF=$P($G(^LEX(757.02,LEXIEN,0)),U,5)
. . K:'$D(LEXTEST)&(+LEXPF'>0) ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN) Q:+LEXPF'>0
. . S LEXOK=0 S:(LEXSO_" ")=LEXST LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN) S:$L(LEXSO) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),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,LEXSO,LEXPF S DA=LEXIEN,LEXSO=$P($G(^LEX(757.02,DA,0)),U,2),LEXPF=$P($G(^LEX(757.02,DA,0)),U,5) Q:'$L(LEXSO)
. I LEXPF>0,'$D(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA
. I LEXPF'>0,$D(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted) ",LEXSO,?58," ",DA
. S:LEXPF>0 ^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)="" K:LEXPF'>0&('$D(LEXTEST)) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),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[HLEXRXD3 2738 printed Sep 23, 2025@19:45:10 Page 2
LEXRXD3 ;ISL/KER - Re-Index 757.02 APCODE ;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 RAPCODE
QUIT
RAPCODE ; Index ^LEX(757.02,"APCODE",CODE,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXPF,LEXSO,LEXST
+2 SET LEXFI="757.02"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""APCODE""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXST=""
SET LEXFI=757.02
SET LEXIDX="APCODE"
SET LEXIDXT="^LEX(757.02,""APCODE"",CODE,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,LEXPF
SET LEXSO=$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,2)
SET LEXPF=$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,5)
+8 if '$DATA(LEXTEST)&(+LEXPF'>0)
KILL ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
if +LEXPF'>0
QUIT
+9 SET LEXOK=0
if (LEXSO_" ")=LEXST
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+10 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
if $LENGTH(LEXSO)
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),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,LEXSO,LEXPF
SET DA=LEXIEN
SET LEXSO=$PIECE($GET(^LEX(757.02,DA,0)),U,2)
SET LEXPF=$PIECE($GET(^LEX(757.02,DA,0)),U,5)
if '$LENGTH(LEXSO)
QUIT
+14 IF LEXPF>0
IF '$DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA))
Begin DoDot:2
+15 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA
End DoDot:2
+16 IF LEXPF'>0
IF $DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA))
Begin DoDot:2
+17 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted) ",LEXSO,?58," ",DA
End DoDot:2
+18 if LEXPF>0
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)=""
if LEXPF'>0&('$DATA(LEXTEST))
KILL ^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)
End DoDot:1
+19 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+20 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+21 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+22 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+23 QUIT
+24 ;
+25 ; Miscellaneous
CLR ; Clear
+1 KILL LEXNAM,LEXTEST,ZTQUEUED
+2 QUIT
