LEXRXS2 ;ISL/KER - Re-Index - Small Files ;08/17/2011
;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 10
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEXT( SACC 1.3
; ^LEX(757.014, SACC 1.3
; ^LEX(757.13, SACC 1.3
; ^LEX(757.14, SACC 1.3
; ^LEX(757.3, SACC 1.3
; ^LEX(757.31, SACC 1.3
; ^LEX(757.32, SACC 1.3
; ^LEX(757.4, SACC 1.3
; ^LEX(757.41, SACC 1.3
; ^LEX(757.2, SACC 1.3
; ^LEX(757.2, SACC 1.3
;
; External References
; FILE^DID ICR 2052
; IX1^DIK ICR 10013
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
;
; Local Variables NEWed or KILLed Elsewhere
; LEXLONG Format flag NEWed/KILLed by Developer
; LEXNAM Task name NEWed/KILLed by LEXRXXT
; ZTQUEUED Task flag NEWed/KILLed by Taskman
;
EN ; Main Entry Point
D R75713,R75714,R7572,R7573,R75731,R75732,R7574,R75741
Q
R75713 ; Source Category file 757.13/757.14
N LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM
S LEXFI="757.13" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT D RM(757.14),RX(757.14),RM(LEXFI),RX(LEXFI)
S LEXIX(1)="AAID, ACID, ACP, APC, APID, B, C and D",LEXNM="Source Category" I $D(LEXLONG) D
. S LEXIX(1)="^LEX(757.13,""AAID"",ID,IEN)",LEXIX(2)="^LEX(757.13,""ACID"",ID,IEN)"
. S LEXIX(3)="^LEX(757.13,""ACP"",CHD,PAR,IEN)",LEXIX(4)="^LEX(757.13,""APC"",PAR,CHD,IEN)"
. S LEXIX(5)="^LEX(757.13,""APID"",ID,IEN)",LEXIX(6)="^LEX(757.13,""B"",CAT,IEN)"
. S LEXIX(7)="^LEX(757.13,""C"",UPPER,IEN)",LEXIX(8)="^LEX(757.13,""D"",WORD,IEN)"
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REX^LEXRXXS(LEXFI,LEXNM,LEXELP,.LEXIX)
Q
R75714 ; Source file 757.14
N LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM
S LEXFI="757.14" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
S LEXIX(1)="B",LEXNM="Source" I $D(LEXLONG) S LEXIX(1)="^LEX(757.14,""B"",NAME,IEN)"
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
Q
R7573 ; Look-up Screens file 757.3
N LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
S LEXFI="757.3" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
S LEXIX(1)="APPS, AS, B, C and D",LEXNM="Look-up Screens" I $D(LEXLONG) D
. S LEXIX(1)="^LEX(757.3,""APPS"",AP,IEN)",LEXIX(2)="^LEX(757.3,""AS"",SCR,IEN)"
. S LEXIX(3)="^LEX(757.3,""B"",DT,IEN)",LEXIX(4)="^LEX(757.3,""C"",DT,IEN)",LEXIX(5)="^LEX(757.3,""D"",DT,IEN)"
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
Q
R75731 ; Displays file 757.31
N LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
S LEXFI="757.31" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
S LEXIX(1)="ADSP, B and C",LEXNM="Displays" I $D(LEXLONG) D
. S LEXIX(1)="^LEX(757.31,""ADSP"",DSP,IEN)",LEXIX(2)="^LEX(757.31,""B"",DES,IEN)",LEXIX(3)="^LEX(757.31,""C"",UPPER,IEN)"
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
Q
R75732 ; Mapping Definitions file 757.32
N LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
S LEXFI="757.32" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
S LEXIX(1)="B",LEXNM="Mapping Definitions" I $D(LEXLONG) S LEXIX(1)="^LEX(757.32,""B"",MMN,IEN)"
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
Q
R7574 ; Shortcuts file 757.4/757.41
N LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
S LEXFI="757.4" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT D RM(757.41),RX(757.41),RM(LEXFI),RX(LEXFI)
S LEXIX(1)="AB, ARA and B",LEXNM="Shortcuts" I $D(LEXLONG) D
. S LEXIX(1)="^LEX(757.4,""AB"",SC,SHCT,IEN)",LEXIX(2)="^LEX(757.4,""ARA"",SC,CXT,SHCT,IEN)",LEXIX(3)="^LEX(757.4,""B"",EXP,IEN)"
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REX^LEXRXXS(LEXFI,LEXNM,LEXELP,.LEXIX)
Q
R75741 ; Shortcut Context file 757.41
N LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
S LEXFI="757.41" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
S LEXIX(1)="B, C and D",LEXNM="Shortcuts" I $D(LEXLONG) D
. S LEXIX(1)="^LEX(757.41,""B"",CON,IEN)",LEXIX(2)="^LEX(757.41,""C"",WRD,IEN)",LEXIX(3)="^LEX(757.41,""D"",WRD,IEN)"
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REX^LEXRXXS(757.41,LEXNM,LEXELP,.LEXIX)
Q
R7572 ; Subset Definition file 757.2
N LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM,LEXP3,LEXP4,LEXOUT,LEXMSG,LEXRT
S LEXFI="757.2" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX("&(LEXRT'["^LEXT(")
S LEXBEG=$$NOW^XLFDT D RM(757.2) N DA,DIK S (LEXP3,LEXP4,DA)=0,DIK="^LEXT(757.2,"
F S DA=$O(^LEXT(757.2,DA)) Q:+DA'>0 D
. S LEXP3=DA,LEXP4=LEXP4+1,DIK=LEXRT
. K ^LEXT(757.2,DA,200,"B") D IX1^DIK
S $P(^LEXT(757.2,0),"^",3)=LEXP3,$P(^LEXT(757.2,0),"^",4)=LEXP4
S LEXIX(1)="B, AA, AB, ADEF, AN, APPS, AUD, C and D",LEXNM="Subset Definitions" I $D(LEXLONG) D
. S LEXIX(1)="^LEXT(757.2,""B"",NAME,IEN)",LEXIX(2)="^LEXT(757.2,""C"",NAME,IEN)",LEXIX(3)="^LEXT(757.2,""D"",WORD,IEN)"
. S LEXIX(4)="^LEXT(757.2,""AA"",ST,IEN)",LEXIX(5)="^LEXT(757.2,""AB"",AN,IEN)",LEXIX(6)="^LEXT(757.2,""ADEF"",FI,IEN)"
. S LEXIX(7)="^LEXT(757.2,""APPS"",FI,IEN)",LEXIX(8)="^LEXT(757.2,""AN"",AN,IEN)",LEXIX(9)="^LEXT(757.2,""AUD"",NAME,USER,SD,IEN)"
. S LEXIX(10)="^LEX(757.1,IEN,200,""B"",USER,IEN2)"
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REX^LEXRXXS(757.2,LEXNM,LEXELP,.LEXIX)
Q
;
; Miscellaneous
RM(X) ; Remove Main
N LEXFI,LEXIX,LEXRT,LEXDIC S LEXFI=+($G(X)) Q:$E(LEXFI,1,3)'="757" Q:'$D(^LEX(LEXFI))&('$D(^LEXT(LEXFI)))
S LEXRT=$S($D(^LEX(LEXFI)):"^LEX(",1:"^LEXT("),LEXIX=""" """,LEXDIC=LEXRT_LEXFI_"," Q:'$L($O(@(LEXDIC_LEXIX_")")))
F S LEXIX=$O(@(LEXDIC_LEXIX_")")) Q:'$L(LEXIX) D
. S:+LEXIX'=LEXIX LEXIX=""""_LEXIX_""""
. N LEXREF S LEXREF=LEXDIC_LEXIX_")" Q:'$D(@LEXREF) K @LEXREF
Q
RX(X) ; Re-Index File X
N DA,DIK,LEXFI,LEXOUT,LEXMSG,LEXRT,LEXP3,LEXP4
S LEXFI=+($G(X)) Q:+LEXFI'>0 Q:'$D(^LEX(LEXFI))&('$D(^LEXT(LEXFI)))
D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX("&(LEXRT'["^LEXT(")
S (LEXP3,LEXP4,DA)=0 F S DA=$O(@(LEXRT_DA_")")) Q:+DA'>0 D
. S LEXP3=DA,LEXP4=LEXP4+1,DIK=LEXRT D IX1^DIK
S $P(@(LEXRT_"0)"),"^",3)=LEXP3,$P(@(LEXRT_"0)"),"^",4)=LEXP4
Q
CLR ; Clear
K LEXLONG,LEXNAM,ZTQUEUED
Q
LEXRXS2 ;ISL/KER - Re-Index - Small Files ;08/17/2011
+1 ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^LEX( SACC 1.3
+5 ; ^LEXT( SACC 1.3
+6 ; ^LEX(757.014, SACC 1.3
+7 ; ^LEX(757.13, SACC 1.3
+8 ; ^LEX(757.14, SACC 1.3
+9 ; ^LEX(757.3, SACC 1.3
+10 ; ^LEX(757.31, SACC 1.3
+11 ; ^LEX(757.32, SACC 1.3
+12 ; ^LEX(757.4, SACC 1.3
+13 ; ^LEX(757.41, SACC 1.3
+14 ; ^LEX(757.2, SACC 1.3
+15 ; ^LEX(757.2, SACC 1.3
+16 ;
+17 ; External References
+18 ; FILE^DID ICR 2052
+19 ; IX1^DIK ICR 10013
+20 ; $$FMDIFF^XLFDT ICR 10103
+21 ; $$NOW^XLFDT ICR 10103
+22 ;
+23 ; Local Variables NEWed or KILLed Elsewhere
+24 ; LEXLONG Format flag NEWed/KILLed by Developer
+25 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+26 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+27 ;
EN ; Main Entry Point
+1 DO R75713
DO R75714
DO R7572
DO R7573
DO R75731
DO R75732
DO R7574
DO R75741
+2 QUIT
R75713 ; Source Category file 757.13/757.14
+1 NEW LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM
+2 SET LEXFI="757.13"
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing file #",LEXFI
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
DO RM(757.14)
DO RX(757.14)
DO RM(LEXFI)
DO RX(LEXFI)
+5 SET LEXIX(1)="AAID, ACID, ACP, APC, APID, B, C and D"
SET LEXNM="Source Category"
IF $DATA(LEXLONG)
Begin DoDot:1
+6 SET LEXIX(1)="^LEX(757.13,""AAID"",ID,IEN)"
SET LEXIX(2)="^LEX(757.13,""ACID"",ID,IEN)"
+7 SET LEXIX(3)="^LEX(757.13,""ACP"",CHD,PAR,IEN)"
SET LEXIX(4)="^LEX(757.13,""APC"",PAR,CHD,IEN)"
+8 SET LEXIX(5)="^LEX(757.13,""APID"",ID,IEN)"
SET LEXIX(6)="^LEX(757.13,""B"",CAT,IEN)"
+9 SET LEXIX(7)="^LEX(757.13,""C"",UPPER,IEN)"
SET LEXIX(8)="^LEX(757.13,""D"",WORD,IEN)"
End DoDot:1
+10 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+11 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+12 DO REX^LEXRXXS(LEXFI,LEXNM,LEXELP,.LEXIX)
+13 QUIT
R75714 ; Source file 757.14
+1 NEW LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM
+2 SET LEXFI="757.14"
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing file #",LEXFI
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
DO RM(LEXFI)
DO RX(LEXFI)
+5 SET LEXIX(1)="B"
SET LEXNM="Source"
IF $DATA(LEXLONG)
SET LEXIX(1)="^LEX(757.14,""B"",NAME,IEN)"
+6 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+7 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+8 DO REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
+9 QUIT
R7573 ; Look-up Screens file 757.3
+1 NEW LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
+2 SET LEXFI="757.3"
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing file #",LEXFI
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
DO RM(LEXFI)
DO RX(LEXFI)
+5 SET LEXIX(1)="APPS, AS, B, C and D"
SET LEXNM="Look-up Screens"
IF $DATA(LEXLONG)
Begin DoDot:1
+6 SET LEXIX(1)="^LEX(757.3,""APPS"",AP,IEN)"
SET LEXIX(2)="^LEX(757.3,""AS"",SCR,IEN)"
+7 SET LEXIX(3)="^LEX(757.3,""B"",DT,IEN)"
SET LEXIX(4)="^LEX(757.3,""C"",DT,IEN)"
SET LEXIX(5)="^LEX(757.3,""D"",DT,IEN)"
End DoDot:1
+8 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+9 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+10 DO REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
+11 QUIT
R75731 ; Displays file 757.31
+1 NEW LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
+2 SET LEXFI="757.31"
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing file #",LEXFI
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
DO RM(LEXFI)
DO RX(LEXFI)
+5 SET LEXIX(1)="ADSP, B and C"
SET LEXNM="Displays"
IF $DATA(LEXLONG)
Begin DoDot:1
+6 SET LEXIX(1)="^LEX(757.31,""ADSP"",DSP,IEN)"
SET LEXIX(2)="^LEX(757.31,""B"",DES,IEN)"
SET LEXIX(3)="^LEX(757.31,""C"",UPPER,IEN)"
End DoDot:1
+7 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+8 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+9 DO REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
+10 QUIT
R75732 ; Mapping Definitions file 757.32
+1 NEW LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
+2 SET LEXFI="757.32"
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing file #",LEXFI
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
DO RM(LEXFI)
DO RX(LEXFI)
+5 SET LEXIX(1)="B"
SET LEXNM="Mapping Definitions"
IF $DATA(LEXLONG)
SET LEXIX(1)="^LEX(757.32,""B"",MMN,IEN)"
+6 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+7 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+8 DO REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
+9 QUIT
R7574 ; Shortcuts file 757.4/757.41
+1 NEW LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
+2 SET LEXFI="757.4"
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing file #",LEXFI
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
DO RM(757.41)
DO RX(757.41)
DO RM(LEXFI)
DO RX(LEXFI)
+5 SET LEXIX(1)="AB, ARA and B"
SET LEXNM="Shortcuts"
IF $DATA(LEXLONG)
Begin DoDot:1
+6 SET LEXIX(1)="^LEX(757.4,""AB"",SC,SHCT,IEN)"
SET LEXIX(2)="^LEX(757.4,""ARA"",SC,CXT,SHCT,IEN)"
SET LEXIX(3)="^LEX(757.4,""B"",EXP,IEN)"
End DoDot:1
+7 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+8 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+9 DO REX^LEXRXXS(LEXFI,LEXNM,LEXELP,.LEXIX)
+10 QUIT
R75741 ; Shortcut Context file 757.41
+1 NEW LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
+2 SET LEXFI="757.41"
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing file #",LEXFI
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
DO RM(LEXFI)
DO RX(LEXFI)
+5 SET LEXIX(1)="B, C and D"
SET LEXNM="Shortcuts"
IF $DATA(LEXLONG)
Begin DoDot:1
+6 SET LEXIX(1)="^LEX(757.41,""B"",CON,IEN)"
SET LEXIX(2)="^LEX(757.41,""C"",WRD,IEN)"
SET LEXIX(3)="^LEX(757.41,""D"",WRD,IEN)"
End DoDot:1
+7 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+8 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+9 DO REX^LEXRXXS(757.41,LEXNM,LEXELP,.LEXIX)
+10 QUIT
R7572 ; Subset Definition file 757.2
+1 NEW LEXFI,LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM,LEXP3,LEXP4,LEXOUT,LEXMSG,LEXRT
+2 SET LEXFI="757.2"
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing file #",LEXFI
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
IF LEXTC=1
QUIT
+4 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
+5 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
IF LEXRT'["^LEX("&(LEXRT'["^LEXT(")
QUIT
+6 SET LEXBEG=$$NOW^XLFDT
DO RM(757.2)
NEW DA,DIK
SET (LEXP3,LEXP4,DA)=0
SET DIK="^LEXT(757.2,"
+7 FOR
SET DA=$ORDER(^LEXT(757.2,DA))
IF +DA'>0
QUIT
Begin DoDot:1
+8 SET LEXP3=DA
SET LEXP4=LEXP4+1
SET DIK=LEXRT
+9 KILL ^LEXT(757.2,DA,200,"B")
DO IX1^DIK
End DoDot:1
+10 SET $PIECE(^LEXT(757.2,0),"^",3)=LEXP3
SET $PIECE(^LEXT(757.2,0),"^",4)=LEXP4
+11 SET LEXIX(1)="B, AA, AB, ADEF, AN, APPS, AUD, C and D"
SET LEXNM="Subset Definitions"
IF $DATA(LEXLONG)
Begin DoDot:1
+12 SET LEXIX(1)="^LEXT(757.2,""B"",NAME,IEN)"
SET LEXIX(2)="^LEXT(757.2,""C"",NAME,IEN)"
SET LEXIX(3)="^LEXT(757.2,""D"",WORD,IEN)"
+13 SET LEXIX(4)="^LEXT(757.2,""AA"",ST,IEN)"
SET LEXIX(5)="^LEXT(757.2,""AB"",AN,IEN)"
SET LEXIX(6)="^LEXT(757.2,""ADEF"",FI,IEN)"
+14 SET LEXIX(7)="^LEXT(757.2,""APPS"",FI,IEN)"
SET LEXIX(8)="^LEXT(757.2,""AN"",AN,IEN)"
SET LEXIX(9)="^LEXT(757.2,""AUD"",NAME,USER,SD,IEN)"
+15 SET LEXIX(10)="^LEX(757.1,IEN,200,""B"",USER,IEN2)"
End DoDot:1
+16 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+17 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+18 DO REX^LEXRXXS(757.2,LEXNM,LEXELP,.LEXIX)
+19 QUIT
+20 ;
+21 ; Miscellaneous
RM(X) ; Remove Main
+1 NEW LEXFI,LEXIX,LEXRT,LEXDIC
SET LEXFI=+($GET(X))
IF $EXTRACT(LEXFI,1,3)'="757"
QUIT
IF '$DATA(^LEX(LEXFI))&('$DATA(^LEXT(LEXFI)))
QUIT
+2 SET LEXRT=$SELECT($DATA(^LEX(LEXFI)):"^LEX(",1:"^LEXT(")
SET LEXIX=""" """
SET LEXDIC=LEXRT_LEXFI_","
IF '$LENGTH($ORDER(@(LEXDIC_LEXIX_")")))
QUIT
+3 FOR
SET LEXIX=$ORDER(@(LEXDIC_LEXIX_")"))
IF '$LENGTH(LEXIX)
QUIT
Begin DoDot:1
+4 IF +LEXIX'=LEXIX
SET LEXIX=""""_LEXIX_""""
+5 NEW LEXREF
SET LEXREF=LEXDIC_LEXIX_")"
IF '$DATA(@LEXREF)
QUIT
KILL @LEXREF
End DoDot:1
+6 QUIT
RX(X) ; Re-Index File X
+1 NEW DA,DIK,LEXFI,LEXOUT,LEXMSG,LEXRT,LEXP3,LEXP4
+2 SET LEXFI=+($GET(X))
IF +LEXFI'>0
QUIT
IF '$DATA(^LEX(LEXFI))&('$DATA(^LEXT(LEXFI)))
QUIT
+3 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
+4 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
IF LEXRT'["^LEX("&(LEXRT'["^LEXT(")
QUIT
+5 SET (LEXP3,LEXP4,DA)=0
FOR
SET DA=$ORDER(@(LEXRT_DA_")"))
IF +DA'>0
QUIT
Begin DoDot:1
+6 SET LEXP3=DA
SET LEXP4=LEXP4+1
SET DIK=LEXRT
DO IX1^DIK
End DoDot:1
+7 SET $PIECE(@(LEXRT_"0)"),"^",3)=LEXP3
SET $PIECE(@(LEXRT_"0)"),"^",4)=LEXP4
+8 QUIT
CLR ; Clear
+1 KILL LEXLONG,LEXNAM,ZTQUEUED
+2 QUIT
