- LEXRXD ;ISL/KER - Re-Index 757.02 B/ACODE/ACT ;04/21/2014
- ;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; ^LEX( SACC 1.3
- ; ^LEX(757.02) SACC 1.3
- ; ^TMP("LEXRX") SACC 2.3.2.5.1
- ;
- ; External References
- ; $$FMDIFF^XLFDT ICR 10103
- ; $$NOW^XLFDT ICR 10103
- ; FILE^DID ICR 2052
- ; IX1^DIK ICR 10013
- ; ^DIM ICR 10016
- ;
- ; Local Variables NEWed or KILLed Elsewhere
- ; LEXNAM Task name NEWed/KILLed by LEXRXXT
- ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
- ; LEXTEST Test variable NEWed/KILLed by Developer
- ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
- ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- ;
- Q
- EN ; Main Entry Point
- R75702 ; Repair file 757.02
- D RB,RACODE,RACT,R75702^LEXRXD2,R75702^LEXRXD3,R75702^LEXRXD4,SET
- Q
- RB ; Index ^LEX(757.02,"B",EXP,IEN)
- ; ^LEX(757.02,IEN,4,"B",EFF,IEN2)
- N DA,DIK,LEXBEG,LEXDIF,LEXED,LEXELP,LEXEND,LEXERR,LEXEXP,LEXFI,LEXIDX,LEXIDXT,LEXIDST,LEXIEN,LEXMC,LEXNDS,LEXNDSS,LEXOK,LEXS,LEXSER,LEXSTR
- S LEXFI="757.02"
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""B""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXNDSS,LEXERR,LEXSER)=0,LEXSTR="",LEXFI="757.02",LEXIDX="B",LEXIDXT="^LEX(757.02,""B"",EXP,IEN)"
- S LEXIDST="^LEX(757.02,IEN,4,""B"",EFF,IEN2)" F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
- . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
- . . S LEXNDS=LEXNDS+1 N LEXOK,LEXEXP S LEXEXP=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
- . . S LEXOK=0 S:LEXEXP=LEXSTR LEXOK=1
- . . I 'LEXOK D
- . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
- . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- . . S:$L(LEXEXP) ^LEX(LEXFI,LEXIDX,LEXEXP,LEXIEN)=""
- . . I $D(^LEX(LEXFI,LEXIEN,4)) D
- . . . N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
- . . . . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)) Q:+LEXS'>0 D
- . . . . . S LEXNDSS=+($G(LEXNDSS))+1 N LEXOK,LEXED S LEXED=$P($G(^LEX(LEXFI,LEXIEN,4,LEXS,0)),"^",1)
- . . . . . S LEXOK=0 S:LEXED=LEXSTR LEXOK=1
- . . . . . I 'LEXOK D
- . . . . . . S LEXSER=LEXSER+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)
- . . . . . . I '$D(ZTQUEUED) W !,?10,757.28,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN,"/",LEXS
- . . . . . S:$L(LEXED) ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXED,LEXS)=""
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . N DA,X S X=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1) I $L(X) D
- . . S DA=LEXIEN
- . . I '$D(^LEX(LEXFI,LEXIDX,X,DA)) D
- . . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
- . . S:$L(X) ^LEX(LEXFI,LEXIDX,X,DA)=""
- . I $D(^LEX(LEXFI,LEXIEN,4)) D
- . . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,4,LEXS)) Q:+LEXS'>0 D
- . . . N DA,X S DA(1)=LEXIEN,DA=LEXS,X=$P($G(^LEX(LEXFI,DA(1),4,DA,0)),"^",1) I $L(X) D
- . . . . I '$D(^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)) D
- . . . . . S LEXSER=LEXSER+1 I '$D(ZTQUEUED) W !,?10,757.28,?19,LEXIDX,?30,"Missing ",X,?58," ",DA(1),"/",DA
- . . . . S:$L(X) ^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)=""
- S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- S LEXSER=$S(+LEXSER>0:LEXSER,1:"") I '$D(ZTQUEUED) W !,$J(LEXSER,5),?10,757.28,?19,LEXIDX,?30,LEXIDST
- 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)
- D REP^LEXRXXS(LEXFI,757.28,LEXIDX,LEXNDSS,LEXSER,LEXIDST)
- Q
- RACODE ; Index ^LEX(757.02,"ACODE",CODE,IEN)
- N DA,DIK,LEXBEG,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
- S LEXFI="757.02"
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""ACODE""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.02,LEXIDX="ACODE",LEXIDXT="^LEX(757.02,""ACODE"",CODE,IEN)"
- F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
- . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
- . . S LEXNDS=LEXNDS+1 N LEXOK,LEXDF,LEXSO S LEXDF=+$P($G(^LEX(757.02,LEXIEN,0)),U,6)
- . . S LEXSO=$P($G(^LEX(757.02,LEXIEN,0)),U,2)
- . . K:'$D(LEXTEST)&(+LEXDF>0) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) Q:+LEXDF>0
- . . S LEXOK=0 S:(LEXSO_" ")=LEXSTR LEXOK=1 I 'LEXOK D
- . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:+LEXDF'>0&($L(LEXSO)) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
- . . . I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . Q:+($P($G(^LEX(LEXFI,LEXIEN,0)),"^",6))>0
- . N DA,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",2) Q:'$L(X)
- . I '$D(^LEX(LEXFI,LEXIDX,(X_" "),DA)) D
- . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
- . S ^LEX(LEXFI,LEXIDX,(X_" "),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
- RACT ; Index ^LEX(757.02,"ACT",CODE,STA,DATE,IEN,HIS)
- N DA,DIK,LEXBEG,LEXDIF,LEXDT,LEXEF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDT,LEXIDX,LEXIDXT,LEXIEN,LEXIHS,LEXISO,LEXIST,LEXN0,LEXN1
- N LEXN1X,LEXN2,LEXN2X,LEXNDS,LEXNH,LEXNI,LEXNIX,LEXPF,LEXSO,LEXST,LEXTS,X
- S LEXFI="757.02"
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""ACT""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXFI=757.02,LEXIDX="ACT",LEXISO="",LEXIDXT="^LEX(757.02,""ACT"",CODE,ST,DT,IEN,HIS)"
- F S LEXISO=$O(^LEX(LEXFI,LEXIDX,LEXISO)) Q:'$L(LEXISO) D
- . N LEXIST S LEXIST="" F S LEXIST=$O(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST)) Q:'$L(LEXIST) D
- . . N LEXIDT S LEXIDT=0 F S LEXIDT=$O(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT)) Q:+LEXIDT'>0 D
- . . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT,LEXIEN)) Q:+LEXIEN'>0 D
- . . . . N LEXIHS S LEXIHS=0 F S LEXIHS=$O(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT,LEXIEN,LEXIHS)) Q:+LEXIHS'>0 D
- . . . . . S LEXNDS=LEXNDS+1 N LEXSO,LEXST,LEXTS,LEXDT,LEXPF,LEXN0,LEXNH,LEXEF,LEXNI,LEXNIX,LEXN1,LEXN1X,LEXN2,LEXN2X S LEXEF=0
- . . . . . S LEXN0=$G(^LEX(757.02,LEXIEN,0)),LEXNH=$G(^LEX(757.02,LEXIEN,4,LEXIHS,0))
- . . . . . S LEXSO=$P(LEXN0,U,2),LEXPF=$P(LEXN0,U,5),LEXDT=$P(LEXNH,U,1),LEXST=$P(LEXNH,U,2)
- . . . . . S LEXTS=LEXST S:+LEXPF>0 LEXTS=LEXTS+2
- . . . . . S LEXNI="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXISO_""","_LEXIST_","_LEXIDT_","_LEXIEN_","_LEXIHS_")"
- . . . . . S LEXN1="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXSO_" "","_LEXST_","_LEXDT_","_LEXIEN_","_LEXIHS_")"
- . . . . . S LEXN2="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXSO_" "","_LEXTS_","_LEXDT_","_LEXIEN_","_LEXIHS_")"
- . . . . . S X="K "_LEXNI D ^DIM Q:'$L($G(X)) S LEXNIX=$G(X)
- . . . . . S X="S "_LEXN1_"=""""" D ^DIM Q:'$L($G(X)) S LEXN1X=$G(X)
- . . . . . S X="S "_LEXN2_"=""""" D ^DIM Q:'$L($G(X)) S LEXN2X=$G(X)
- . . . . . X:'$D(LEXTEST)&(LEXNI'=LEXN1)&(LEXNI'=LEXN2) LEXNIX
- . . . . . I LEXNI'=LEXN1,LEXNI'=LEXN2 D
- . . . . . . S LEXERR=LEXERR+1
- . . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSO,?58," ",LEXIEN W:+LEXIHS>0 "/",+LEXIHS
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . N LEXIHS S LEXIHS=0 F S LEXIHS=$O(^LEX(LEXFI,LEXIEN,4,LEXIHS)) Q:+LEXIHS'>0 D
- . . N DA,DIK,LEXSO,LEXPF,LEXDT,LEXST,LEXTS S DA(1)=LEXIEN,DA=LEXIHS
- . . S LEXSO=$P($G(^LEX(LEXFI,DA(1),0)),U,2),LEXPF=$P($G(^LEX(LEXFI,DA(1),0)),U,5)
- . . S LEXDT=$P($G(^LEX(LEXFI,DA(1),4,DA,0)),U,1) Q:LEXDT'?7N S LEXST=$P($G(^LEX(LEXFI,DA(1),4,DA,0)),U,2) Q:LEXST'?1N
- . . S LEXTS=LEXST S:+LEXPF>0 LEXTS=LEXTS+2
- . . I '$D(^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXST,+LEXDT,DA(1),DA)) D
- . . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXST,"/",LEXDT,?58," ",DA(1),"/",DA
- . . I LEXTS>LEXST,'$D(^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXTS,+LEXDT,DA(1),DA)) D
- . . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXTS,"/",LEXDT,?58," ",DA(1),"/",DA
- . . S:$L(LEXSO)&($L(LEXST))&($L(LEXDT)) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXST,+LEXDT,DA(1),DA)=""
- . . I LEXTS>LEXST S:$L(LEXSO)&($L(LEXTS))&($L(LEXDT)) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXTS,+LEXDT,DA(1),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
- SET ; Re-Index (Set logic only)
- Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
- N LEXOUT,LEXMSG S LEXFI=757.02
- D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
- S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX"
- S LEXPRE=$G(^TMP("LEXRX",$J,"T",1,"ELAP"))
- S LEXBEG=$$NOW^XLFDT,LEXNM=$$FN^LEXRXXM(LEXFI)
- S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI))
- Q:LEXTC=1 I '$D(ZTQUEUED) W !,?8,"Re-Indexing",!
- N LEXIEN,LEXP3,LEXP4 S (LEXP3,LEXP4,LEXIEN)=0
- F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . S LEXP3=LEXIEN,LEXP4=LEXP4+1
- . N DA,DIK S DA=LEXIEN,DIK=LEXRT D IX1^DIK
- S $P(^LEX(LEXFI,0),"^",3)=LEXP3,$P(^LEX(LEXFI,0),"^",4)=LEXP4
- Q:$D(LEXQ) 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,"ALLIX",,,"Re-Index",LEXELP)
- S LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
- S ^TMP("LEXRX",$J,"T",1,"ELAP")=LEXELP
- Q
- CLR ; Clear
- K LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
- Q
- LEXRXD ;ISL/KER - Re-Index 757.02 B/ACODE/ACT ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX( SACC 1.3
- +5 ; ^LEX(757.02) SACC 1.3
- +6 ; ^TMP("LEXRX") SACC 2.3.2.5.1
- +7 ;
- +8 ; External References
- +9 ; $$FMDIFF^XLFDT ICR 10103
- +10 ; $$NOW^XLFDT ICR 10103
- +11 ; FILE^DID ICR 2052
- +12 ; IX1^DIK ICR 10013
- +13 ; ^DIM ICR 10016
- +14 ;
- +15 ; Local Variables NEWed or KILLed Elsewhere
- +16 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
- +17 ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
- +18 ; LEXTEST Test variable NEWed/KILLed by Developer
- +19 ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
- +20 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- +21 ;
- +22 QUIT
- EN ; Main Entry Point
- R75702 ; Repair file 757.02
- +1 DO RB
- DO RACODE
- DO RACT
- DO R75702^LEXRXD2
- DO R75702^LEXRXD3
- DO R75702^LEXRXD4
- DO SET
- +2 QUIT
- RB ; Index ^LEX(757.02,"B",EXP,IEN)
- +1 ; ^LEX(757.02,IEN,4,"B",EFF,IEN2)
- +2 NEW DA,DIK,LEXBEG,LEXDIF,LEXED,LEXELP,LEXEND,LEXERR,LEXEXP,LEXFI,LEXIDX,LEXIDXT,LEXIDST,LEXIEN,LEXMC,LEXNDS,LEXNDSS,LEXOK,LEXS,LEXSER,LEXSTR
- +3 SET LEXFI="757.02"
- +4 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""B""")
- IF LEXTC=1
- QUIT
- +5 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS,LEXNDSS,LEXERR,LEXSER)=0
- SET LEXSTR=""
- SET LEXFI="757.02"
- SET LEXIDX="B"
- SET LEXIDXT="^LEX(757.02,""B"",EXP,IEN)"
- +6 SET LEXIDST="^LEX(757.02,IEN,4,""B"",EFF,IEN2)"
- FOR
- SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
- IF '$LENGTH(LEXSTR)
- QUIT
- Begin DoDot:1
- +7 NEW LEXIEN
- SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:2
- +8 SET LEXNDS=LEXNDS+1
- NEW LEXOK,LEXEXP
- SET LEXEXP=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",1)
- +9 SET LEXOK=0
- IF LEXEXP=LEXSTR
- SET LEXOK=1
- +10 IF 'LEXOK
- Begin DoDot:3
- +11 SET LEXERR=LEXERR+1
- IF '$DATA(LEXTEST)
- KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
- +12 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- End DoDot:3
- +13 IF $LENGTH(LEXEXP)
- SET ^LEX(LEXFI,LEXIDX,LEXEXP,LEXIEN)=""
- +14 IF $DATA(^LEX(LEXFI,LEXIEN,4))
- Begin DoDot:3
- +15 NEW LEXSTR
- SET LEXSTR=""
- FOR
- SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR))
- IF '$LENGTH(LEXSTR)
- QUIT
- Begin DoDot:4
- +16 NEW LEXS
- SET LEXS=0
- FOR
- SET LEXS=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS))
- IF +LEXS'>0
- QUIT
- Begin DoDot:5
- +17 SET LEXNDSS=+($GET(LEXNDSS))+1
- NEW LEXOK,LEXED
- SET LEXED=$PIECE($GET(^LEX(LEXFI,LEXIEN,4,LEXS,0)),"^",1)
- +18 SET LEXOK=0
- IF LEXED=LEXSTR
- SET LEXOK=1
- +19 IF 'LEXOK
- Begin DoDot:6
- +20 SET LEXSER=LEXSER+1
- IF '$DATA(LEXTEST)
- KILL ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)
- +21 IF '$DATA(ZTQUEUED)
- WRITE !,?10,757.28,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN,"/",LEXS
- End DoDot:6
- +22 IF $LENGTH(LEXED)
- SET ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXED,LEXS)=""
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +24 NEW DA,X
- SET X=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",1)
- IF $LENGTH(X)
- Begin DoDot:2
- +25 SET DA=LEXIEN
- +26 IF '$DATA(^LEX(LEXFI,LEXIDX,X,DA))
- Begin DoDot:3
- +27 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
- End DoDot:3
- +28 IF $LENGTH(X)
- SET ^LEX(LEXFI,LEXIDX,X,DA)=""
- End DoDot:2
- +29 IF $DATA(^LEX(LEXFI,LEXIEN,4))
- Begin DoDot:2
- +30 NEW LEXS
- SET LEXS=0
- FOR
- SET LEXS=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXS))
- IF +LEXS'>0
- QUIT
- Begin DoDot:3
- +31 NEW DA,X
- SET DA(1)=LEXIEN
- SET DA=LEXS
- SET X=$PIECE($GET(^LEX(LEXFI,DA(1),4,DA,0)),"^",1)
- IF $LENGTH(X)
- Begin DoDot:4
- +32 IF '$DATA(^LEX(LEXFI,DA(1),4,LEXIDX,X,DA))
- Begin DoDot:5
- +33 SET LEXSER=LEXSER+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?10,757.28,?19,LEXIDX,?30,"Missing ",X,?58," ",DA(1),"/",DA
- End DoDot:5
- +34 IF $LENGTH(X)
- SET ^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +35 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
- IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- +36 SET LEXSER=$SELECT(+LEXSER>0:LEXSER,1:"")
- IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXSER,5),?10,757.28,?19,LEXIDX,?30,LEXIDST
- +37 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +38 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +39 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- +40 DO REP^LEXRXXS(LEXFI,757.28,LEXIDX,LEXNDSS,LEXSER,LEXIDST)
- +41 QUIT
- RACODE ; Index ^LEX(757.02,"ACODE",CODE,IEN)
- +1 NEW DA,DIK,LEXBEG,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
- +2 SET LEXFI="757.02"
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""ACODE""")
- IF LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS,LEXERR)=0
- SET LEXSTR=""
- SET LEXFI=757.02
- SET LEXIDX="ACODE"
- SET LEXIDXT="^LEX(757.02,""ACODE"",CODE,IEN)"
- +5 FOR
- SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
- IF '$LENGTH(LEXSTR)
- QUIT
- Begin DoDot:1
- +6 NEW LEXIEN
- SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:2
- +7 SET LEXNDS=LEXNDS+1
- NEW LEXOK,LEXDF,LEXSO
- SET LEXDF=+$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,6)
- +8 SET LEXSO=$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,2)
- +9 IF '$DATA(LEXTEST)&(+LEXDF>0)
- KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
- IF +LEXDF>0
- QUIT
- +10 SET LEXOK=0
- IF (LEXSO_" ")=LEXSTR
- SET LEXOK=1
- IF 'LEXOK
- Begin DoDot:3
- +11 SET LEXERR=LEXERR+1
- IF '$DATA(LEXTEST)
- KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
- IF +LEXDF'>0&($LENGTH(LEXSO))
- SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
- +12 IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +14 IF +($PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",6))>0
- QUIT
- +15 NEW DA,X
- SET DA=LEXIEN
- SET X=$PIECE($GET(^LEX(LEXFI,DA,0)),"^",2)
- IF '$LENGTH(X)
- QUIT
- +16 IF '$DATA(^LEX(LEXFI,LEXIDX,(X_" "),DA))
- Begin DoDot:2
- +17 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",X,?58," ",DA
- End DoDot:2
- +18 SET ^LEX(LEXFI,LEXIDX,(X_" "),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
- RACT ; Index ^LEX(757.02,"ACT",CODE,STA,DATE,IEN,HIS)
- +1 NEW DA,DIK,LEXBEG,LEXDIF,LEXDT,LEXEF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDT,LEXIDX,LEXIDXT,LEXIEN,LEXIHS,LEXISO,LEXIST,LEXN0,LEXN1
- +2 NEW LEXN1X,LEXN2,LEXN2X,LEXNDS,LEXNH,LEXNI,LEXNIX,LEXPF,LEXSO,LEXST,LEXTS,X
- +3 SET LEXFI="757.02"
- +4 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""ACT""")
- IF LEXTC=1
- QUIT
- +5 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS,LEXERR)=0
- SET LEXFI=757.02
- SET LEXIDX="ACT"
- SET LEXISO=""
- SET LEXIDXT="^LEX(757.02,""ACT"",CODE,ST,DT,IEN,HIS)"
- +6 FOR
- SET LEXISO=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO))
- IF '$LENGTH(LEXISO)
- QUIT
- Begin DoDot:1
- +7 NEW LEXIST
- SET LEXIST=""
- FOR
- SET LEXIST=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST))
- IF '$LENGTH(LEXIST)
- QUIT
- Begin DoDot:2
- +8 NEW LEXIDT
- SET LEXIDT=0
- FOR
- SET LEXIDT=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT))
- IF +LEXIDT'>0
- QUIT
- Begin DoDot:3
- +9 NEW LEXIEN
- SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:4
- +10 NEW LEXIHS
- SET LEXIHS=0
- FOR
- SET LEXIHS=$ORDER(^LEX(LEXFI,LEXIDX,LEXISO,LEXIST,LEXIDT,LEXIEN,LEXIHS))
- IF +LEXIHS'>0
- QUIT
- Begin DoDot:5
- +11 SET LEXNDS=LEXNDS+1
- NEW LEXSO,LEXST,LEXTS,LEXDT,LEXPF,LEXN0,LEXNH,LEXEF,LEXNI,LEXNIX,LEXN1,LEXN1X,LEXN2,LEXN2X
- SET LEXEF=0
- +12 SET LEXN0=$GET(^LEX(757.02,LEXIEN,0))
- SET LEXNH=$GET(^LEX(757.02,LEXIEN,4,LEXIHS,0))
- +13 SET LEXSO=$PIECE(LEXN0,U,2)
- SET LEXPF=$PIECE(LEXN0,U,5)
- SET LEXDT=$PIECE(LEXNH,U,1)
- SET LEXST=$PIECE(LEXNH,U,2)
- +14 SET LEXTS=LEXST
- IF +LEXPF>0
- SET LEXTS=LEXTS+2
- +15 SET LEXNI="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXISO_""","_LEXIST_","_LEXIDT_","_LEXIEN_","_LEXIHS_")"
- +16 SET LEXN1="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXSO_" "","_LEXST_","_LEXDT_","_LEXIEN_","_LEXIHS_")"
- +17 SET LEXN2="^LEX("_LEXFI_","""_LEXIDX_""","""_LEXSO_" "","_LEXTS_","_LEXDT_","_LEXIEN_","_LEXIHS_")"
- +18 SET X="K "_LEXNI
- DO ^DIM
- IF '$LENGTH($GET(X))
- QUIT
- SET LEXNIX=$GET(X)
- +19 SET X="S "_LEXN1_"="""""
- DO ^DIM
- IF '$LENGTH($GET(X))
- QUIT
- SET LEXN1X=$GET(X)
- +20 SET X="S "_LEXN2_"="""""
- DO ^DIM
- IF '$LENGTH($GET(X))
- QUIT
- SET LEXN2X=$GET(X)
- +21 IF '$DATA(LEXTEST)&(LEXNI'=LEXN1)&(LEXNI'=LEXN2)
- XECUTE LEXNIX
- +22 IF LEXNI'=LEXN1
- IF LEXNI'=LEXN2
- Begin DoDot:6
- +23 SET LEXERR=LEXERR+1
- +24 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSO,?58," ",LEXIEN
- IF +LEXIHS>0
- WRITE "/",+LEXIHS
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +25 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +26 NEW LEXIHS
- SET LEXIHS=0
- FOR
- SET LEXIHS=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXIHS))
- IF +LEXIHS'>0
- QUIT
- Begin DoDot:2
- +27 NEW DA,DIK,LEXSO,LEXPF,LEXDT,LEXST,LEXTS
- SET DA(1)=LEXIEN
- SET DA=LEXIHS
- +28 SET LEXSO=$PIECE($GET(^LEX(LEXFI,DA(1),0)),U,2)
- SET LEXPF=$PIECE($GET(^LEX(LEXFI,DA(1),0)),U,5)
- +29 SET LEXDT=$PIECE($GET(^LEX(LEXFI,DA(1),4,DA,0)),U,1)
- IF LEXDT'?7N
- QUIT
- SET LEXST=$PIECE($GET(^LEX(LEXFI,DA(1),4,DA,0)),U,2)
- IF LEXST'?1N
- QUIT
- +30 SET LEXTS=LEXST
- IF +LEXPF>0
- SET LEXTS=LEXTS+2
- +31 IF '$DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXST,+LEXDT,DA(1),DA))
- Begin DoDot:3
- +32 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXST,"/",LEXDT,?58," ",DA(1),"/",DA
- End DoDot:3
- +33 IF LEXTS>LEXST
- IF '$DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXTS,+LEXDT,DA(1),DA))
- Begin DoDot:3
- +34 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXTS,"/",LEXDT,?58," ",DA(1),"/",DA
- End DoDot:3
- +35 IF $LENGTH(LEXSO)&($LENGTH(LEXST))&($LENGTH(LEXDT))
- SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXST,+LEXDT,DA(1),DA)=""
- +36 IF LEXTS>LEXST
- IF $LENGTH(LEXSO)&($LENGTH(LEXTS))&($LENGTH(LEXDT))
- SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),+LEXTS,+LEXDT,DA(1),DA)=""
- End DoDot:2
- End DoDot:1
- +37 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
- IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- +38 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +39 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +40 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- +41 QUIT
- +42 ;
- +43 ; Miscellaneous
- SET ; Re-Index (Set logic only)
- +1 IF '$DATA(LEXSET)
- QUIT
- NEW LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
- +2 NEW LEXOUT,LEXMSG
- SET LEXFI=757.02
- +3 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
- +4 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
- IF LEXRT'["^LEX"
- QUIT
- +5 SET LEXPRE=$GET(^TMP("LEXRX",$JOB,"T",1,"ELAP"))
- +6 SET LEXBEG=$$NOW^XLFDT
- SET LEXNM=$$FN^LEXRXXM(LEXFI)
- +7 SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- +8 IF LEXTC=1
- QUIT
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing",!
- +9 NEW LEXIEN,LEXP3,LEXP4
- SET (LEXP3,LEXP4,LEXIEN)=0
- +10 FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- IF +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +11 SET LEXP3=LEXIEN
- SET LEXP4=LEXP4+1
- +12 NEW DA,DIK
- SET DA=LEXIEN
- SET DIK=LEXRT
- DO IX1^DIK
- End DoDot:1
- +13 SET $PIECE(^LEX(LEXFI,0),"^",3)=LEXP3
- SET $PIECE(^LEX(LEXFI,0),"^",4)=LEXP4
- +14 IF $DATA(LEXQ)
- QUIT
- SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +15 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +16 DO REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
- +17 SET LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
- +18 SET ^TMP("LEXRX",$JOB,"T",1,"ELAP")=LEXELP
- +19 QUIT
- CLR ; Clear
- +1 KILL LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
- +2 QUIT
