LEXRXD3 ;ISL/KER - Re-Index 757.02 ADCODE/APCODE ;08/17/2011
;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 10
;
; 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 RADCODE,RAPCODE Q
RADCODE ; Index ^LEX(757.02,"ADCODE",CODE,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 ""ADCODE""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXST="",LEXFI=757.02,LEXIDX="ADCODE",LEXIDXT="^LEX(757.02,""ADCODE"",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,LEXDF,LEXSO S LEXSO=$P($G(^LEX(757.02,LEXIEN,0)),U,2) I '$L(LEXSO) 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 LEXDF=$P($G(^LEX(757.02,LEXIEN,0)),U,6) I +LEXDF'>0 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:(LEXSO_" ")=LEXST LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
. . . S:$L(LEXSO)&(+LEXDF=1) ^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,X,DIK,LEXDF,LEXSO S DA=LEXIEN,LEXSO=$P($G(^LEX(LEXFI,DA,0)),U,2),(X,LEXDF)=$P($G(^LEX(LEXFI,DA,0)),U,6) Q:'$L(LEXSO)
. I X=1,'$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 X'=1,$D(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted)",?58," ",DA
. S:X=1 ^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)="" K:X'=1&('$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
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
LEXRXD3 ;ISL/KER - Re-Index 757.02 ADCODE/APCODE ;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.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 RADCODE
DO RAPCODE
QUIT
RADCODE ; Index ^LEX(757.02,"ADCODE",CODE,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 ""ADCODE""")
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXST=""
SET LEXFI=757.02
SET LEXIDX="ADCODE"
SET LEXIDXT="^LEX(757.02,""ADCODE"",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,LEXDF,LEXSO
SET LEXSO=$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,2)
IF '$LENGTH(LEXSO)
Begin DoDot:3
+8 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
+9 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXST,?58," ",LEXIEN
End DoDot:3
QUIT
+10 SET LEXDF=$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,6)
IF +LEXDF'>0
Begin DoDot:3
+11 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
+12 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXST,?58," ",LEXIEN
End DoDot:3
QUIT
+13 SET LEXOK=0
IF (LEXSO_" ")=LEXST
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+14 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXST,LEXIEN)
+15 IF $LENGTH(LEXSO)&(+LEXDF=1)
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
+16 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXST,?58," ",LEXIEN
End DoDot:3
End DoDot:2
End DoDot:1
+17 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+18 NEW DA,X,DIK,LEXDF,LEXSO
SET DA=LEXIEN
SET LEXSO=$PIECE($GET(^LEX(LEXFI,DA,0)),U,2)
SET (X,LEXDF)=$PIECE($GET(^LEX(LEXFI,DA,0)),U,6)
IF '$LENGTH(LEXSO)
QUIT
+19 IF X=1
IF '$DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA))
Begin DoDot:2
+20 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA
End DoDot:2
+21 IF X'=1
IF $DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA))
Begin DoDot:2
+22 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted)",?58," ",DA
End DoDot:2
+23 IF X=1
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)=""
IF X'=1&('$DATA(LEXTEST))
KILL ^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)
End DoDot:1
+24 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+25 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+26 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+27 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+28 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
