- 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 Feb 18, 2025@23:35:21 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
