Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXRXS2

LEXRXS2.m

Go to the documentation of this file.
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