- LEXRXS2 ;ISL/KER - Re-Index - Small Files ;08/17/2011
- ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
- ;
- ; 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXS2 8176 printed Feb 18, 2025@23:35:30 Page 2
- LEXRXS2 ;ISL/KER - Re-Index - Small Files ;08/17/2011
- +1 ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
- +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