LEXRXXA ;ISL/KER - Re-Index Ask ;08/17/2011
;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEXT( SACC 1.3
;
; External References
; ^DIC ICR 10006
; ^DIR ICR 10026
; $$UP^XLFSTR ICR 10104
;
; Local Variables NEWed or KILLed Elsewhere
; LEXFI File Number NEWed/KILLed by ONE^LEXRX
;
Q
AMSO(X) ; All, Major, Supporting or One File
N LEX,DIR,DTOUT,DUOUT,DIRUT,DIROUT,LEXB,LEXN,Y K LEX
D AMSOF S LEX="" S LEXB=$$BOLD^LEXRXXM,LEXN=$$NORM^LEXRXXM
S DIR(0)="SAO^A:All Lexicon Files;M:Major Lexicon Files"
S DIR(0)=DIR(0)_";S:Supporting Lexicon Files;O:One Lexicon File"
S (DIR("?"),DIR("??"))="^D AMSOH^LEXRXXA"
S DIR("PRE")="S X=$$AMSOP^LEXRXXA($G(X))"
S DIR("A")=" Select "_LEXB_"A"_LEXN_"ll, "_LEXB_"M"_LEXN_"ajor, "
S DIR("A")=DIR("A")_LEXB_"S"_LEXN_"upporting or "_LEXB_"O"_LEXN
S DIR("A")=DIR("A")_"ne Lexicon file(s): (A/M/S/O) "
W ! D ^DIR S X=Y
Q X
AMSOP(X) ; All, Major, Supporting or One File - Pre-process
N Y Q:'$L($G(X)) "" Q:$G(X)["^" "^" S X=$G(X)
S Y=$$UP^XLFSTR($E(X,1)) S:"^A^M^S^O^?^"'[("^"_Y_"^") X="??"
Q X
AMSOH ; All, Major, Supporting or One File - Help
W:$L($G(IOF))&($D(LEX)) @IOF D:$D(LEX) AMSOH2
AMSOF ; All, Major, Supporting or One File - List Files
W:$L($G(IOF))&('$D(LEX)) @IOF
N LEXB,LEXN,LEXC,LEXT,LEXF,LEX1,LEX2,LEX3
S LEXB=$$BOLD^LEXRXXM,LEXN=$$NORM^LEXRXXM
S:'$D(LEX) (LEXB,LEXN)=""
S LEX1=3,LEX2=6,LEX3=24 S:$D(LEX) LEX2=LEX2-1,LEX3=LEX3-1
W !," Repair/Re-Index Lexicon Cross-References",!
S LEXC="",LEXT="",LEXF=""
W !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
S LEXC=LEXB_"A"_LEXN
S LEXT="All files"
S LEXF="757*"
W !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
S LEXC="",LEXT="",LEXF=""
S LEXC=LEXB_"M"_LEXN
S LEXT="Major files"
S LEXF="757, 757.001, 757.01, 757.02, 757.1, 757.21 and 757.33"
W !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
S LEXC="",LEXT="",LEXF=""
S LEXC=LEXB_"S"_LEXN
S LEXT="Supporting files"
S LEXF="757.011, 757.014, 757.03, 757.04, 757.05, 757.06,"
W !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
S LEXC=LEXB_" "_LEXN
S LEXT=""
S LEXF="757.11, 757.12, 757.13, 757.14, 757.2, 757.3,"
W !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
S LEXC=LEXB_" "_LEXN
S LEXT=""
S LEXF="757.31, 757.4 and 757.41"
W !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
S LEXC="",LEXT="",LEXF=""
S LEXC=LEXB_"O"_LEXN
S LEXT="One file"
S LEXF="Select a single Lexicon file"
W !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
Q
AMSOH2 ; All, Major, Supporting or One File - Help
N LEXB,LEXN S LEXB=$$BOLD^LEXRXXM,LEXN=$$NORM^LEXRXXM
W !," The cross-references of the Major (larger) files"
W " involved with the"
W !," Lexicon Lookup will be repaired. During the repair"
W " process the "
W !," cross-references are not deleted. Only those cross-"
W "reference nodes "
W !," that fail verification will be deleted. The Supporting"
W " (smaller) files",!," will be re-indexed.",!,?1," "
W !,?1,LEXB,"Users may remain on the system.",LEXN
W !,?1," "
Q
;
CO(X) ; Ask to Continue
S LEXTY=$G(LEXTY) N DIR,DTOUT,DUOUT,DIRUT,DIROUT,Y
S DIR(0)="YAO",(DIR("?"),DIR("??"))="^D COH^LEXRXXA"
S DIR("A")=" Do you wish to continue? (Y/N) "
S DIR("PRE")="S:X[""?"" X=""??""" W ! D ^DIR
S X=+Y S:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) X="^"
N LEXTY
Q X
COH ; Continue Help
N LEXFN,LEXAC S LEXAC="repair/re-index"
S:+($G(LEXTY))=1 LEXAC="repair" S:+($G(LEXTY))=2 LEXAC="re-index"
I +($G(LEXTY))'>0 D
. W !," Answer 'Yes' to ",LEXAC," the Lexicon's cross-references"
I +($G(LEXTY))=1&(+($G(LEXFI))'>0) D
. W !," Answer 'Yes' to ",LEXAC," the Lexicon's cross-references"
. W " of the",!," larger files"
I +($G(LEXTY))=2&(+($G(LEXFI))'>0) D
. W !," Answer 'Yes' to ",LEXAC," the Lexicon's cross-references"
. W " of the",!," smaller files"
I +($G(LEXTY))=3&(+($G(LEXFI))'>0) D
. W !," Answer 'Yes' to ",LEXAC," the cross-references of all"
. W !," of the Lexicon's files"
I +($G(LEXTY))>0&(+($G(LEXFI))>0) D
. I $D(^LEX(+($G(LEXFI))))!($D(^LEXT(+($G(LEXFI))))) D Q
. . N LEXFN S LEXFN=$$FN^LEXRXXM(+($G(LEXFI)))
. . I $L($G(LEXFN))&(+($G(LEXFI))>0) D
. . . W !," Answer 'Yes' to ",LEXAC," the cross-references of "
. . . W "the ",LEXFN,!," file #",$G(LEXFI)
. . I '$L($G(LEXFN))&(+($G(LEXFI))>0) D
. . . W !," Answer 'Yes' to ",LEXAC," the cross-references of "
. . . W "file #",$G(LEXFI)
. W !," Answer 'Yes' to ",LEXAC," the cross-references of "
. W "the file(s)"
Q
;
FI(X) ; Select File
N DIC,DTOUT,DUOUT,Y,LEX S DIC="^DIC(",DIC(0)="AEMQ"
S DIC("A")=" Select Lexicon File: "
S DIC("S")="I +($$FV^LEXRXXM(+Y))>0"
W ! D ^DIC K DIC("S") S LEX=+($$FV^LEXRXXM(+Y))
Q:$D(DTOUT)!($D(DUOUT)) "^" S X=+Y Q:LEX>0 X
Q "^"
;
; Miscellaneous
CLR ; Clear
K LEXFI
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXXA 5044 printed Dec 13, 2024@02:09:27 Page 2
LEXRXXA ;ISL/KER - Re-Index Ask ;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 ;
+7 ; External References
+8 ; ^DIC ICR 10006
+9 ; ^DIR ICR 10026
+10 ; $$UP^XLFSTR ICR 10104
+11 ;
+12 ; Local Variables NEWed or KILLed Elsewhere
+13 ; LEXFI File Number NEWed/KILLed by ONE^LEXRX
+14 ;
+15 QUIT
AMSO(X) ; All, Major, Supporting or One File
+1 NEW LEX,DIR,DTOUT,DUOUT,DIRUT,DIROUT,LEXB,LEXN,Y
KILL LEX
+2 DO AMSOF
SET LEX=""
SET LEXB=$$BOLD^LEXRXXM
SET LEXN=$$NORM^LEXRXXM
+3 SET DIR(0)="SAO^A:All Lexicon Files;M:Major Lexicon Files"
+4 SET DIR(0)=DIR(0)_";S:Supporting Lexicon Files;O:One Lexicon File"
+5 SET (DIR("?"),DIR("??"))="^D AMSOH^LEXRXXA"
+6 SET DIR("PRE")="S X=$$AMSOP^LEXRXXA($G(X))"
+7 SET DIR("A")=" Select "_LEXB_"A"_LEXN_"ll, "_LEXB_"M"_LEXN_"ajor, "
+8 SET DIR("A")=DIR("A")_LEXB_"S"_LEXN_"upporting or "_LEXB_"O"_LEXN
+9 SET DIR("A")=DIR("A")_"ne Lexicon file(s): (A/M/S/O) "
+10 WRITE !
DO ^DIR
SET X=Y
+11 QUIT X
AMSOP(X) ; All, Major, Supporting or One File - Pre-process
+1 NEW Y
if '$LENGTH($GET(X))
QUIT ""
if $GET(X)["^"
QUIT "^"
SET X=$GET(X)
+2 SET Y=$$UP^XLFSTR($EXTRACT(X,1))
if "^A^M^S^O^?^"'[("^"_Y_"^")
SET X="??"
+3 QUIT X
AMSOH ; All, Major, Supporting or One File - Help
+1 if $LENGTH($GET(IOF))&($DATA(LEX))
WRITE @IOF
if $DATA(LEX)
DO AMSOH2
AMSOF ; All, Major, Supporting or One File - List Files
+1 if $LENGTH($GET(IOF))&('$DATA(LEX))
WRITE @IOF
+2 NEW LEXB,LEXN,LEXC,LEXT,LEXF,LEX1,LEX2,LEX3
+3 SET LEXB=$$BOLD^LEXRXXM
SET LEXN=$$NORM^LEXRXXM
+4 if '$DATA(LEX)
SET (LEXB,LEXN)=""
+5 SET LEX1=3
SET LEX2=6
SET LEX3=24
if $DATA(LEX)
SET LEX2=LEX2-1
SET LEX3=LEX3-1
+6 WRITE !," Repair/Re-Index Lexicon Cross-References",!
+7 SET LEXC=""
SET LEXT=""
SET LEXF=""
+8 WRITE !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
+9 SET LEXC=LEXB_"A"_LEXN
+10 SET LEXT="All files"
+11 SET LEXF="757*"
+12 WRITE !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
+13 SET LEXC=""
SET LEXT=""
SET LEXF=""
+14 SET LEXC=LEXB_"M"_LEXN
+15 SET LEXT="Major files"
+16 SET LEXF="757, 757.001, 757.01, 757.02, 757.1, 757.21 and 757.33"
+17 WRITE !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
+18 SET LEXC=""
SET LEXT=""
SET LEXF=""
+19 SET LEXC=LEXB_"S"_LEXN
+20 SET LEXT="Supporting files"
+21 SET LEXF="757.011, 757.014, 757.03, 757.04, 757.05, 757.06,"
+22 WRITE !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
+23 SET LEXC=LEXB_" "_LEXN
+24 SET LEXT=""
+25 SET LEXF="757.11, 757.12, 757.13, 757.14, 757.2, 757.3,"
+26 WRITE !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
+27 SET LEXC=LEXB_" "_LEXN
+28 SET LEXT=""
+29 SET LEXF="757.31, 757.4 and 757.41"
+30 WRITE !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
+31 SET LEXC=""
SET LEXT=""
SET LEXF=""
+32 SET LEXC=LEXB_"O"_LEXN
+33 SET LEXT="One file"
+34 SET LEXF="Select a single Lexicon file"
+35 WRITE !,?LEX1,LEXC,?LEX2,LEXT,?LEX3,LEXF
+36 QUIT
AMSOH2 ; All, Major, Supporting or One File - Help
+1 NEW LEXB,LEXN
SET LEXB=$$BOLD^LEXRXXM
SET LEXN=$$NORM^LEXRXXM
+2 WRITE !," The cross-references of the Major (larger) files"
+3 WRITE " involved with the"
+4 WRITE !," Lexicon Lookup will be repaired. During the repair"
+5 WRITE " process the "
+6 WRITE !," cross-references are not deleted. Only those cross-"
+7 WRITE "reference nodes "
+8 WRITE !," that fail verification will be deleted. The Supporting"
+9 WRITE " (smaller) files",!," will be re-indexed.",!,?1," "
+10 WRITE !,?1,LEXB,"Users may remain on the system.",LEXN
+11 WRITE !,?1," "
+12 QUIT
+13 ;
CO(X) ; Ask to Continue
+1 SET LEXTY=$GET(LEXTY)
NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,Y
+2 SET DIR(0)="YAO"
SET (DIR("?"),DIR("??"))="^D COH^LEXRXXA"
+3 SET DIR("A")=" Do you wish to continue? (Y/N) "
+4 SET DIR("PRE")="S:X[""?"" X=""??"""
WRITE !
DO ^DIR
+5 SET X=+Y
if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
SET X="^"
+6 NEW LEXTY
+7 QUIT X
COH ; Continue Help
+1 NEW LEXFN,LEXAC
SET LEXAC="repair/re-index"
+2 if +($GET(LEXTY))=1
SET LEXAC="repair"
if +($GET(LEXTY))=2
SET LEXAC="re-index"
+3 IF +($GET(LEXTY))'>0
Begin DoDot:1
+4 WRITE !," Answer 'Yes' to ",LEXAC," the Lexicon's cross-references"
End DoDot:1
+5 IF +($GET(LEXTY))=1&(+($GET(LEXFI))'>0)
Begin DoDot:1
+6 WRITE !," Answer 'Yes' to ",LEXAC," the Lexicon's cross-references"
+7 WRITE " of the",!," larger files"
End DoDot:1
+8 IF +($GET(LEXTY))=2&(+($GET(LEXFI))'>0)
Begin DoDot:1
+9 WRITE !," Answer 'Yes' to ",LEXAC," the Lexicon's cross-references"
+10 WRITE " of the",!," smaller files"
End DoDot:1
+11 IF +($GET(LEXTY))=3&(+($GET(LEXFI))'>0)
Begin DoDot:1
+12 WRITE !," Answer 'Yes' to ",LEXAC," the cross-references of all"
+13 WRITE !," of the Lexicon's files"
End DoDot:1
+14 IF +($GET(LEXTY))>0&(+($GET(LEXFI))>0)
Begin DoDot:1
+15 IF $DATA(^LEX(+($GET(LEXFI))))!($DATA(^LEXT(+($GET(LEXFI)))))
Begin DoDot:2
+16 NEW LEXFN
SET LEXFN=$$FN^LEXRXXM(+($GET(LEXFI)))
+17 IF $LENGTH($GET(LEXFN))&(+($GET(LEXFI))>0)
Begin DoDot:3
+18 WRITE !," Answer 'Yes' to ",LEXAC," the cross-references of "
+19 WRITE "the ",LEXFN,!," file #",$GET(LEXFI)
End DoDot:3
+20 IF '$LENGTH($GET(LEXFN))&(+($GET(LEXFI))>0)
Begin DoDot:3
+21 WRITE !," Answer 'Yes' to ",LEXAC," the cross-references of "
+22 WRITE "file #",$GET(LEXFI)
End DoDot:3
End DoDot:2
QUIT
+23 WRITE !," Answer 'Yes' to ",LEXAC," the cross-references of "
+24 WRITE "the file(s)"
End DoDot:1
+25 QUIT
+26 ;
FI(X) ; Select File
+1 NEW DIC,DTOUT,DUOUT,Y,LEX
SET DIC="^DIC("
SET DIC(0)="AEMQ"
+2 SET DIC("A")=" Select Lexicon File: "
+3 SET DIC("S")="I +($$FV^LEXRXXM(+Y))>0"
+4 WRITE !
DO ^DIC
KILL DIC("S")
SET LEX=+($$FV^LEXRXXM(+Y))
+5 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT "^"
SET X=+Y
if LEX>0
QUIT X
+6 QUIT "^"
+7 ;
+8 ; Miscellaneous
CLR ; Clear
+1 KILL LEXFI
+2 QUIT
