LEXRXG3 ;ISL/KER - Re-Index 757.33 ASRC/ATAR ;08/17/2011
;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEX(757.33, SACC 1.3
; ^LEX(757.32, 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
R75733 ; Repair file 757.33
D RASRC,RATAR
Q
RASRC ; Index ^LEX(757.33,"ASRC",DEF,SRC,TGT,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF
S LEXFI="757.33"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.33 ""ASRC""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXFI=757.33,LEXIDX="ASRC",LEXIDXT="^LEX(757.33,""ASRC"",DEF,SRC,TGT,IEN)"
N LEXDEF S LEXDEF="" F S LEXDEF=$O(^LEX(LEXFI,LEXIDX,LEXDEF)) Q:'$L(LEXDEF) D
. N LEXSRC S LEXSRC="" F S LEXSRC=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC)) Q:'$L(LEXSRC) D
. . N LEXTGT S LEXTGT="" F S LEXTGT=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT)) Q:'$L(LEXTGT) D
. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT,LEXIEN)) Q:+LEXIEN'>0 D
. . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
. . . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
. . . . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
. . . . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
. . . . Q:'$L(LEXD) Q:'$L(LEXN) Q:'$L(LEXS) Q:'$L(LEXT)
. . . . I LEXDEF'=LEXN!($TR(LEXSRC," ","")'=LEXS)!($TR(LEXTGT," ","")'=LEXT) D
. . . . . N DA S DA=LEXIEN S LEXERR=LEXERR+1
. . . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT,LEXIEN)
. . . . . S:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),LEXIEN)=""
. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Rev ",LEXS,?58," ",DA
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
. S DA=LEXIEN,LEXN0=$G(^LEX(757.33,+LEXIEN,0))
. S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
. S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
. S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
. Q:'$L(LEXD) Q:'$L(LEXN) Q:'$L(LEXS) Q:'$L(LEXT)
. I '$D(^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Rev ",LEXS,?58," ",DA
. S ^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA)=""
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
H 2 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
RATAR ; Index ^LEX(757.33,"ATAR",DEF,TAR,SRC,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF
S LEXFI="757.33"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.33 ""ATAR""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXFI=757.33,LEXIDX="ATAR",LEXIDXT="^LEX(757.33,""ATAR"",DEF,SRC,TGT,IEN)"
N LEXDEF S LEXDEF="" F S LEXDEF=$O(^LEX(LEXFI,LEXIDX,LEXDEF)) Q:'$L(LEXDEF) D
. N LEXTGT S LEXTGT="" F S LEXTGT=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT)) Q:'$L(LEXTGT) D
. . N LEXSRC S LEXSRC="" F S LEXSRC=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC)) Q:'$L(LEXSRC) D
. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN)) Q:+LEXIEN'>0 D
. . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
. . . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
. . . . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
. . . . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
. . . . Q:'$L(LEXD) Q:'$L(LEXN) Q:'$L(LEXS) Q:'$L(LEXT)
. . . . I LEXDEF'=LEXN!($TR(LEXSRC," ","")'=LEXS)!($TR(LEXTGT," ","")'=LEXT) D
. . . . . N DA S DA=LEXIEN S LEXERR=LEXERR+1
. . . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN)
. . . . . S:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),LEXIEN)=""
. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Rev ",LEXS,?58," ",DA
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
. S DA=LEXIEN,LEXN0=$G(^LEX(757.33,+LEXIEN,0))
. S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
. S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
. S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
. Q:'$L(LEXD) Q:'$L(LEXN) Q:'$L(LEXS) Q:'$L(LEXT)
. I '$D(^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Rev ",LEXS,?58," ",DA
. S ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA)=""
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
H 2 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[HLEXRXG3 5477 printed Dec 13, 2024@02:09:23 Page 2
LEXRXG3 ;ISL/KER - Re-Index 757.33 ASRC/ATAR ;08/17/2011
+1 ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^LEX( SACC 1.3
+5 ; ^LEX(757.33, SACC 1.3
+6 ; ^LEX(757.32, SACC 1.3
+7 ;
+8 ; External References
+9 ; $$FMDIFF^XLFDT ICR 10103
+10 ; $$NOW^XLFDT ICR 10103
+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
R75733 ; Repair file 757.33
+1 DO RASRC
DO RATAR
+2 QUIT
RASRC ; Index ^LEX(757.33,"ASRC",DEF,SRC,TGT,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF
+2 SET LEXFI="757.33"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.33 ""ASRC""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXFI=757.33
SET LEXIDX="ASRC"
SET LEXIDXT="^LEX(757.33,""ASRC"",DEF,SRC,TGT,IEN)"
+5 NEW LEXDEF
SET LEXDEF=""
FOR
SET LEXDEF=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF))
if '$LENGTH(LEXDEF)
QUIT
Begin DoDot:1
+6 NEW LEXSRC
SET LEXSRC=""
FOR
SET LEXSRC=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC))
if '$LENGTH(LEXSRC)
QUIT
Begin DoDot:2
+7 NEW LEXTGT
SET LEXTGT=""
FOR
SET LEXTGT=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT))
if '$LENGTH(LEXTGT)
QUIT
Begin DoDot:3
+8 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:4
+9 SET LEXNDS=LEXNDS+1
NEW LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
+10 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
+11 SET LEXD=$PIECE(LEXN0,"^",4)
SET LEXN=$PIECE($GET(^LEX(757.32,+LEXD,0)),"^",1)
+12 SET LEXS=$PIECE(LEXN0,"^",2)
SET LEXT=$PIECE(LEXN0,"^",3)
+13 if '$LENGTH(LEXD)
QUIT
if '$LENGTH(LEXN)
QUIT
if '$LENGTH(LEXS)
QUIT
if '$LENGTH(LEXT)
QUIT
+14 IF LEXDEF'=LEXN!($TRANSLATE(LEXSRC," ","")'=LEXS)!($TRANSLATE(LEXTGT," ","")'=LEXT)
Begin DoDot:5
+15 NEW DA
SET DA=LEXIEN
SET LEXERR=LEXERR+1
+16 if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT,LEXIEN)
+17 if '$DATA(LEXTEST)
SET ^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),LEXIEN)=""
+18 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Rev ",LEXS,?58," ",DA
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+20 NEW DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
+21 SET DA=LEXIEN
SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
+22 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
+23 SET LEXD=$PIECE(LEXN0,"^",4)
SET LEXN=$PIECE($GET(^LEX(757.32,+LEXD,0)),"^",1)
+24 SET LEXS=$PIECE(LEXN0,"^",2)
SET LEXT=$PIECE(LEXN0,"^",3)
+25 if '$LENGTH(LEXD)
QUIT
if '$LENGTH(LEXN)
QUIT
if '$LENGTH(LEXS)
QUIT
if '$LENGTH(LEXT)
QUIT
+26 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA))
Begin DoDot:2
+27 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Rev ",LEXS,?58," ",DA
End DoDot:2
+28 SET ^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA)=""
End DoDot:1
+29 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+30 HANG 2
SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+31 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+32 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+33 QUIT
RATAR ; Index ^LEX(757.33,"ATAR",DEF,TAR,SRC,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF
+2 SET LEXFI="757.33"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.33 ""ATAR""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXFI=757.33
SET LEXIDX="ATAR"
SET LEXIDXT="^LEX(757.33,""ATAR"",DEF,SRC,TGT,IEN)"
+5 NEW LEXDEF
SET LEXDEF=""
FOR
SET LEXDEF=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF))
if '$LENGTH(LEXDEF)
QUIT
Begin DoDot:1
+6 NEW LEXTGT
SET LEXTGT=""
FOR
SET LEXTGT=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT))
if '$LENGTH(LEXTGT)
QUIT
Begin DoDot:2
+7 NEW LEXSRC
SET LEXSRC=""
FOR
SET LEXSRC=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC))
if '$LENGTH(LEXSRC)
QUIT
Begin DoDot:3
+8 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:4
+9 SET LEXNDS=LEXNDS+1
NEW LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
+10 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
+11 SET LEXD=$PIECE(LEXN0,"^",4)
SET LEXN=$PIECE($GET(^LEX(757.32,+LEXD,0)),"^",1)
+12 SET LEXS=$PIECE(LEXN0,"^",2)
SET LEXT=$PIECE(LEXN0,"^",3)
+13 if '$LENGTH(LEXD)
QUIT
if '$LENGTH(LEXN)
QUIT
if '$LENGTH(LEXS)
QUIT
if '$LENGTH(LEXT)
QUIT
+14 IF LEXDEF'=LEXN!($TRANSLATE(LEXSRC," ","")'=LEXS)!($TRANSLATE(LEXTGT," ","")'=LEXT)
Begin DoDot:5
+15 NEW DA
SET DA=LEXIEN
SET LEXERR=LEXERR+1
+16 if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN)
+17 if '$DATA(LEXTEST)
SET ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),LEXIEN)=""
+18 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Rev ",LEXS,?58," ",DA
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+20 NEW DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
+21 SET DA=LEXIEN
SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
+22 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
+23 SET LEXD=$PIECE(LEXN0,"^",4)
SET LEXN=$PIECE($GET(^LEX(757.32,+LEXD,0)),"^",1)
+24 SET LEXS=$PIECE(LEXN0,"^",2)
SET LEXT=$PIECE(LEXN0,"^",3)
+25 if '$LENGTH(LEXD)
QUIT
if '$LENGTH(LEXN)
QUIT
if '$LENGTH(LEXS)
QUIT
if '$LENGTH(LEXT)
QUIT
+26 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA))
Begin DoDot:2
+27 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Rev ",LEXS,?58," ",DA
End DoDot:2
+28 SET ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA)=""
End DoDot:1
+29 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+30 HANG 2
SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+31 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+32 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+33 QUIT
+34 ;
+35 ; Miscellaneous
CLR ; Clear
+1 KILL LEXNAM,LEXTEST,ZTQUEUED
+2 QUIT
