LEXXFI8 ;ISL/KER - File Info - Miscellaneous ;04/21/2014
;;2.0;LEXICON UTILITY;**32,80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXCS") SACC 2.3.2.5.1
; ^TMP("LEXCS",$J) SACC 2.3.2.5.1
; ^TMP("LEXINS") SACC 2.3.2.5.1
; ^TMP("LEXINS",$J) SACC 2.3.2.5.1
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$GET1^DIQ ICR 2056
; $$NOW^XLFDT ICR 10103
; %XY^%RCR ICR 10022
; FILE^DID ICR 2052
; IX^DIC ICR 10006
; ^%DT ICR 10003
; ^DIC ICR 10006
;
Q
LEX(X) ; LEX* File
N LEXN S X=$G(X) Q:+X=0 0 S LEXN=$$GL(X) Q:$E(LEXN,1,4)="^LEX" 1
Q 0
IC(X) ; IC* File
S X=$G(X) I "^80^80.1^80.2^80.3^81^81.1^81.3^"[("^"_+X_"^") Q 1
Q 0
GL(X) ; Global Location
N DIERR,LEXE,LEXN S X=$G(X) Q:+X=0 "" D FILE^DID(+X,"N","GLOBAL NAME","LEXN","LEXE")
S X="" S:'$D(DIERR) X=$G(LEXN("GLOBAL NAME"))
Q X
FN(X) ; File Name
N DIERR,LEXE,LEXN S X=$G(X) D FILE^DID(+X,"N","NAME","LEXN","LEXE")
S X="" S:'$D(DIERR) X=$G(LEXN("NAME"))
Q X
INS(X) ; Installed
N %X,%Y,LEXFI,LEXIN,LEXPH,LEXPK,LEXPV,LEXRV,LEXSQ,LEXVR K ^TMP("LEXINS",$J)
S LEXFI=+($G(X)) Q:+LEXFI'>0 ""
S LEXVR=$P($$VR(LEXFI),"^",1) Q:'$L(LEXVR) "" Q:+LEXVR'>0 ""
S LEXRV=$P($$RV(LEXFI),"^",1) Q:'$L(LEXRV) "" Q:+LEXRV'>0 ""
S LEXPK=$$PKG(LEXFI) Q:'$L(LEXPK) "" Q:+LEXPK'>0 ""
S LEXPV=$$PH(LEXPK,LEXVR) Q:+LEXPV'>0 ""
S %X="^DIC(9.4,"_LEXPK_",22,"_LEXPV_",""PAH"",",%Y="^TMP(""LEXINS"","_$J_",""PAH""," D %XY^%RCR
S LEXPH=$O(^TMP("LEXINS",$J,"PAH","B",LEXRV,0)) I LEXPH'>0 D
. S LEXPH="",LEXSQ=$O(^TMP("LEXINS",$J,"PAH","B",(LEXRV_" ")))
. Q:'$L(LEXSQ) Q:$E(LEXSQ,1,$L(LEXRV))'=LEXRV
. S LEXPH=$O(^TMP("LEXINS",$J,"PAH","B",LEXSQ,0))
S LEXIN=$P($P($G(^TMP("LEXINS",$J,"PAH",+LEXPH,0)),"^",2),".",1)
S X=$S(+LEXIN>0:$$SD(+LEXIN),1:"") S:$L(X)'=10 X=""
K ^TMP("LEXINS",$J)
Q X
VR(X) ; File Version
N DIERR,LEXCDT,LEXE,LEXEX,LEXFI,LEXL,LEXN,LEXRTN,LEXVR,LEXVRD
S LEXFI=$G(X) N DIERR,LEXN,LEXNM,LEXE,LEXEX,LEXL,LEXRTN
D FILE^DID(+LEXFI,"N","VERSION","LEXN","LEXE") S LEXVR="" I '$D(DIERR) D
. S LEXVR=$G(LEXN("VERSION")) S LEXRTN=$S($P(+LEXFI,".",1)=757:"LEXA",$P(+LEXFI,".",1)=80:"ICDCODE",$P(+LEXFI,".",1)=81:"ICPTCOD",1:"")
. Q:'$L(LEXRTN) S LEXEX="S LEXL=$T(+2^"_LEXRTN_")" X LEXEX
. Q:'$L(LEXL) I $P(LEXL,";",3)=LEXVR,$L($P(LEXL,";",6)) S LEXVRD=$$LTS($P(LEXL,";",6))
S LEXCDT="" S:LEXFI=81.2 LEXCDT=$$DDT
S X=$G(LEXVR) S:$L($G(LEXVR))&($L($G(LEXVRD))) X=X_"^"_$G(LEXVRD)
S:$L($G(LEXVR))&($L($G(LEXVRD)))&($L(LEXCDT)) X=X_"^"_$G(LEXCDT)
Q X
RV(X) ; File Revision
N DIERR,LEXE,LEXN S X=$G(X)
D FILE^DID(+X,"N","PACKAGE REVISION DATA","LEXN","LEXE")
S X="" S:'$D(DIERR) X=$G(LEXN("PACKAGE REVISION DATA"))
S:+$P(X,"^",2) $P(X,"^",2)=$$SD($P(X,"^",2))
Q X
DDT(X) ; CPT Distribution Date
N LEXDDT S LEXDDT=$$GET1^DIQ(81.2,"1,",.02,"I") Q:'$L(LEXDDT) "" Q:+LEXDDT'>0 "" S X=$$SD(LEXDDT)
Q X
ADR(LEX) ; Mailing Address
N DIC,DTOUT,DUOUT,X,Y S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="FO-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX
S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="ISC-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX
Q "ISC-SLC.DOMAIN.EXT"
MX(X) ; Mix Case
Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
LTS(X) ; Long to Short Date
N %DT,Y S X=$G(X) Q:'$L(X) "" S %DT="T" D ^%DT S X=$$SD(Y)
Q X
SD(X) ; Short Date
S X=$G(X),X=$TR($$FMTE^XLFDT($P(X,".",1),"5DZ"),"@"," ")
Q X
PKG(X) ; Package
N D,DIC,DTOUT,DUOUT,LEXFI,LEXN S LEXFI=+($G(X)) Q:+LEXFI'>0 ""
S LEXN=$S($P(LEXFI,".",1)=757:"LEXICON UTILITY",$P(LEXFI,".",1)=80:"DRG GROUPER",$P(LEXFI,".",1)=81:"CPT/HCPCS CODES",1:"")
Q:'$L(LEXN) N X,Y S DIC="^DIC(9.4,",D="B",DIC(0)="X",X=LEXN D IX^DIC
S X=+($G(Y))
Q X
PH(X,Y) ; Patch History
N DA,DIC,DTOUT,DUOUT,LEXPK,LEXVR
S (DA(1),LEXPK)=+($G(X)) Q:+LEXPK'>0 "" S LEXVR=$G(Y) Q:'$L(LEXVR) "" Q:+LEXVR'>0 ""
S DIC="^DIC(9.4,"_DA(1)_",22,",X=LEXVR,DIC(0)="X"
D ^DIC S X=+($G(Y)) S:+Y'>0 X=""
Q X
TIC(X) ; Time
Q $$NOW^XLFDT
ELAP(X,Y) ; Elapsed Time (start,end)
Q $TR($$FMDIFF^XLFDT(+($G(Y)),+($G(X)),3)," ","0")
LDR(X) ; Leader
N LEXFI,LEXMOD S LEXFI=+($G(X)) Q:LEXFI'>0 0 S LEXMOD=$$MOD(LEXFI),X=$S(+LEXMOD>0:" * ",1:" ")
Q X
MOD(X) ; Modifier File
N LEXFI,LEXSRC,LEXE,LEXTAG,LEXRTN,LEXCTR,LEXLDR,LEXMOD
S LEXSRC=+($G(X)) Q:LEXSRC'>0 0
S LEXFI="",LEXE=0,LEXTAG="FILES",LEXRTN="LEXXFI",LEXCTR=0,LEXMOD=0
F D Q:LEXFI="" Q:+LEXE>0
. S LEXCTR=LEXCTR+1
. S LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")" X LEXEX
. S LEXFI=$P(LEXLINE,";;",2,3)
. S LEXLDR=$P(LEXFI,";;",1),LEXFI=$P(LEXFI,";;",2)
. Q:'$L(LEXFI) Q:+LEXFI'=LEXSRC
. S LEXMOD=$S(+LEXLDR>0:1,1:0) S:LEXMOD>0 LEXE=1
S X=LEXMOD
Q X
MF(X) ; Modified Files
N LEXMOD,LEXT S LEXMOD=+($G(X)) Q:LEXMOD'>0
S LEXT=" * "_$S(LEXMOD>1:"These ",1:"This ")_"file"
S LEXT=LEXT_$S(LEXMOD>1:"s ",1:" ")
S LEXT=LEXT_"contain"_$S(LEXMOD>1:" ",1:"s ")
S LEXT=LEXT_"fields that may be modified at the site."
D BL^LEXXFI8,TL^LEXXFI8(LEXT)
S LEXT=" The Checksum"_$S(LEXMOD>1:"s ",1:" ")
S LEXT=LEXT_"for "_$S(LEXMOD>1:"these ",1:"this ")
S LEXT=LEXT_"file"_$S(LEXMOD>1:"s ",1:" ")
S LEXT=LEXT_"may vary from site to site."
D TL^LEXXFI8(LEXT)
Q
BL ; Blank Line
N LEXI,LEXT S LEXI=+($O(^TMP("LEXCS",$J," "),-1)),LEXT=$G(^TMP("LEXCS",$J,+LEXI))
Q:(LEXI+1)'>1 D:LEXT'=" " TL(" ")
Q
TL(X) ; Text Line
S X=$G(X) W:'$D(ZTQUEUED) !,X
N LEXI S LEXI=+($O(^TMP("LEXCS",$J," "),-1))+1,^TMP("LEXCS",$J,LEXI)=X,^TMP("LEXCS",$J,0)=LEXI
Q
TT(X,Y) ; Title Line
N LEXFI,LEXTT,LEXT,LEXN,LEXNM S LEXFI=$G(X),LEXTT=$G(Y) S:+($$IF(LEXFI))'>0 LEXFI=""
S:+LEXFI>0 LEXNM=$$FN(LEXFI)_" File (#"_+LEXFI_")" S:+LEXFI'>0 LEXNM="Lexicon/ICD/CPT File"
S LEXT=" "_LEXNM_" "_$G(LEXTT) S:+($G(LEXMUL))>0&($E(LEXT,$L(LEXT))'="s") LEXT=LEXT_"s"
D BL,TL(LEXT) S $P(LEXN,"=",$L(LEXT))="",LEXN=" "_LEXN D TL(LEXN)
Q
IF(X) ; Is File on the List of Files
N LEXTAG,LEXRTN,LEXCTR,LEXCTL,LEXFI,LEXLINE,LEXOK S LEXCTL=$G(X) Q:'$L(LEXCTL) 0 Q:+LEXCTL'>0 0
S LEXFI="",LEXTAG="FILES",LEXRTN="LEXXFI",(LEXCTR,LEXOK)=0
F D Q:LEXFI="" Q:+LEXOK>0
. S LEXCTR=LEXCTR+1
. S LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")" X LEXEX
. S LEXFI=$P(LEXLINE,";;",2,3),LEXFI=$P(LEXFI,";;",2)
. Q:'$L(LEXFI) S:+LEXFI=+LEXCTL LEXOK=1
S X=LEXOK
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXFI8 6587 printed Nov 22, 2024@17:20:16 Page 2
LEXXFI8 ;ISL/KER - File Info - Miscellaneous ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**32,80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXCS") SACC 2.3.2.5.1
+5 ; ^TMP("LEXCS",$J) SACC 2.3.2.5.1
+6 ; ^TMP("LEXINS") SACC 2.3.2.5.1
+7 ; ^TMP("LEXINS",$J) SACC 2.3.2.5.1
+8 ;
+9 ; External References
+10 ; $$FMDIFF^XLFDT ICR 10103
+11 ; $$FMTE^XLFDT ICR 10103
+12 ; $$GET1^DIQ ICR 2056
+13 ; $$NOW^XLFDT ICR 10103
+14 ; %XY^%RCR ICR 10022
+15 ; FILE^DID ICR 2052
+16 ; IX^DIC ICR 10006
+17 ; ^%DT ICR 10003
+18 ; ^DIC ICR 10006
+19 ;
+20 QUIT
LEX(X) ; LEX* File
+1 NEW LEXN
SET X=$GET(X)
if +X=0
QUIT 0
SET LEXN=$$GL(X)
if $EXTRACT(LEXN,1,4)="^LEX"
QUIT 1
+2 QUIT 0
IC(X) ; IC* File
+1 SET X=$GET(X)
IF "^80^80.1^80.2^80.3^81^81.1^81.3^"[("^"_+X_"^")
QUIT 1
+2 QUIT 0
GL(X) ; Global Location
+1 NEW DIERR,LEXE,LEXN
SET X=$GET(X)
if +X=0
QUIT ""
DO FILE^DID(+X,"N","GLOBAL NAME","LEXN","LEXE")
+2 SET X=""
if '$DATA(DIERR)
SET X=$GET(LEXN("GLOBAL NAME"))
+3 QUIT X
FN(X) ; File Name
+1 NEW DIERR,LEXE,LEXN
SET X=$GET(X)
DO FILE^DID(+X,"N","NAME","LEXN","LEXE")
+2 SET X=""
if '$DATA(DIERR)
SET X=$GET(LEXN("NAME"))
+3 QUIT X
INS(X) ; Installed
+1 NEW %X,%Y,LEXFI,LEXIN,LEXPH,LEXPK,LEXPV,LEXRV,LEXSQ,LEXVR
KILL ^TMP("LEXINS",$JOB)
+2 SET LEXFI=+($GET(X))
if +LEXFI'>0
QUIT ""
+3 SET LEXVR=$PIECE($$VR(LEXFI),"^",1)
if '$LENGTH(LEXVR)
QUIT ""
if +LEXVR'>0
QUIT ""
+4 SET LEXRV=$PIECE($$RV(LEXFI),"^",1)
if '$LENGTH(LEXRV)
QUIT ""
if +LEXRV'>0
QUIT ""
+5 SET LEXPK=$$PKG(LEXFI)
if '$LENGTH(LEXPK)
QUIT ""
if +LEXPK'>0
QUIT ""
+6 SET LEXPV=$$PH(LEXPK,LEXVR)
if +LEXPV'>0
QUIT ""
+7 SET %X="^DIC(9.4,"_LEXPK_",22,"_LEXPV_",""PAH"","
SET %Y="^TMP(""LEXINS"","_$JOB_",""PAH"","
DO %XY^%RCR
+8 SET LEXPH=$ORDER(^TMP("LEXINS",$JOB,"PAH","B",LEXRV,0))
IF LEXPH'>0
Begin DoDot:1
+9 SET LEXPH=""
SET LEXSQ=$ORDER(^TMP("LEXINS",$JOB,"PAH","B",(LEXRV_" ")))
+10 if '$LENGTH(LEXSQ)
QUIT
if $EXTRACT(LEXSQ,1,$LENGTH(LEXRV))'=LEXRV
QUIT
+11 SET LEXPH=$ORDER(^TMP("LEXINS",$JOB,"PAH","B",LEXSQ,0))
End DoDot:1
+12 SET LEXIN=$PIECE($PIECE($GET(^TMP("LEXINS",$JOB,"PAH",+LEXPH,0)),"^",2),".",1)
+13 SET X=$SELECT(+LEXIN>0:$$SD(+LEXIN),1:"")
if $LENGTH(X)'=10
SET X=""
+14 KILL ^TMP("LEXINS",$JOB)
+15 QUIT X
VR(X) ; File Version
+1 NEW DIERR,LEXCDT,LEXE,LEXEX,LEXFI,LEXL,LEXN,LEXRTN,LEXVR,LEXVRD
+2 SET LEXFI=$GET(X)
NEW DIERR,LEXN,LEXNM,LEXE,LEXEX,LEXL,LEXRTN
+3 DO FILE^DID(+LEXFI,"N","VERSION","LEXN","LEXE")
SET LEXVR=""
IF '$DATA(DIERR)
Begin DoDot:1
+4 SET LEXVR=$GET(LEXN("VERSION"))
SET LEXRTN=$SELECT($PIECE(+LEXFI,".",1)=757:"LEXA",$PIECE(+LEXFI,".",1)=80:"ICDCODE",$PIECE(+LEXFI,".",1)=81:"ICPTCOD",1:"")
+5 if '$LENGTH(LEXRTN)
QUIT
SET LEXEX="S LEXL=$T(+2^"_LEXRTN_")"
XECUTE LEXEX
+6 if '$LENGTH(LEXL)
QUIT
IF $PIECE(LEXL,";",3)=LEXVR
IF $LENGTH($PIECE(LEXL,";",6))
SET LEXVRD=$$LTS($PIECE(LEXL,";",6))
End DoDot:1
+7 SET LEXCDT=""
if LEXFI=81.2
SET LEXCDT=$$DDT
+8 SET X=$GET(LEXVR)
if $LENGTH($GET(LEXVR))&($LENGTH($GET(LEXVRD)))
SET X=X_"^"_$GET(LEXVRD)
+9 if $LENGTH($GET(LEXVR))&($LENGTH($GET(LEXVRD)))&($LENGTH(LEXCDT))
SET X=X_"^"_$GET(LEXCDT)
+10 QUIT X
RV(X) ; File Revision
+1 NEW DIERR,LEXE,LEXN
SET X=$GET(X)
+2 DO FILE^DID(+X,"N","PACKAGE REVISION DATA","LEXN","LEXE")
+3 SET X=""
if '$DATA(DIERR)
SET X=$GET(LEXN("PACKAGE REVISION DATA"))
+4 if +$PIECE(X,"^",2)
SET $PIECE(X,"^",2)=$$SD($PIECE(X,"^",2))
+5 QUIT X
DDT(X) ; CPT Distribution Date
+1 NEW LEXDDT
SET LEXDDT=$$GET1^DIQ(81.2,"1,",.02,"I")
if '$LENGTH(LEXDDT)
QUIT ""
if +LEXDDT'>0
QUIT ""
SET X=$$SD(LEXDDT)
+2 QUIT X
ADR(LEX) ; Mailing Address
+1 NEW DIC,DTOUT,DUOUT,X,Y
SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="FO-SLC.DOMAIN.EXT"
DO ^DIC
if +Y>0
QUIT LEX
+2 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="ISC-SLC.DOMAIN.EXT"
DO ^DIC
if +Y>0
QUIT LEX
+3 QUIT "ISC-SLC.DOMAIN.EXT"
MX(X) ; Mix Case
+1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TRANSLATE($EXTRACT(X,2,$LENGTH(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
LTS(X) ; Long to Short Date
+1 NEW %DT,Y
SET X=$GET(X)
if '$LENGTH(X)
QUIT ""
SET %DT="T"
DO ^%DT
SET X=$$SD(Y)
+2 QUIT X
SD(X) ; Short Date
+1 SET X=$GET(X)
SET X=$TRANSLATE($$FMTE^XLFDT($PIECE(X,".",1),"5DZ"),"@"," ")
+2 QUIT X
PKG(X) ; Package
+1 NEW D,DIC,DTOUT,DUOUT,LEXFI,LEXN
SET LEXFI=+($GET(X))
if +LEXFI'>0
QUIT ""
+2 SET LEXN=$SELECT($PIECE(LEXFI,".",1)=757:"LEXICON UTILITY",$PIECE(LEXFI,".",1)=80:"DRG GROUPER",$PIECE(LEXFI,".",1)=81:"CPT/HCPCS CODES",1:"")
+3 if '$LENGTH(LEXN)
QUIT
NEW X,Y
SET DIC="^DIC(9.4,"
SET D="B"
SET DIC(0)="X"
SET X=LEXN
DO IX^DIC
+4 SET X=+($GET(Y))
+5 QUIT X
PH(X,Y) ; Patch History
+1 NEW DA,DIC,DTOUT,DUOUT,LEXPK,LEXVR
+2 SET (DA(1),LEXPK)=+($GET(X))
if +LEXPK'>0
QUIT ""
SET LEXVR=$GET(Y)
if '$LENGTH(LEXVR)
QUIT ""
if +LEXVR'>0
QUIT ""
+3 SET DIC="^DIC(9.4,"_DA(1)_",22,"
SET X=LEXVR
SET DIC(0)="X"
+4 DO ^DIC
SET X=+($GET(Y))
if +Y'>0
SET X=""
+5 QUIT X
TIC(X) ; Time
+1 QUIT $$NOW^XLFDT
ELAP(X,Y) ; Elapsed Time (start,end)
+1 QUIT $TRANSLATE($$FMDIFF^XLFDT(+($GET(Y)),+($GET(X)),3)," ","0")
LDR(X) ; Leader
+1 NEW LEXFI,LEXMOD
SET LEXFI=+($GET(X))
if LEXFI'>0
QUIT 0
SET LEXMOD=$$MOD(LEXFI)
SET X=$SELECT(+LEXMOD>0:" * ",1:" ")
+2 QUIT X
MOD(X) ; Modifier File
+1 NEW LEXFI,LEXSRC,LEXE,LEXTAG,LEXRTN,LEXCTR,LEXLDR,LEXMOD
+2 SET LEXSRC=+($GET(X))
if LEXSRC'>0
QUIT 0
+3 SET LEXFI=""
SET LEXE=0
SET LEXTAG="FILES"
SET LEXRTN="LEXXFI"
SET LEXCTR=0
SET LEXMOD=0
+4 FOR
Begin DoDot:1
+5 SET LEXCTR=LEXCTR+1
+6 SET LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")"
XECUTE LEXEX
+7 SET LEXFI=$PIECE(LEXLINE,";;",2,3)
+8 SET LEXLDR=$PIECE(LEXFI,";;",1)
SET LEXFI=$PIECE(LEXFI,";;",2)
+9 if '$LENGTH(LEXFI)
QUIT
if +LEXFI'=LEXSRC
QUIT
+10 SET LEXMOD=$SELECT(+LEXLDR>0:1,1:0)
if LEXMOD>0
SET LEXE=1
End DoDot:1
if LEXFI=""
QUIT
if +LEXE>0
QUIT
+11 SET X=LEXMOD
+12 QUIT X
MF(X) ; Modified Files
+1 NEW LEXMOD,LEXT
SET LEXMOD=+($GET(X))
if LEXMOD'>0
QUIT
+2 SET LEXT=" * "_$SELECT(LEXMOD>1:"These ",1:"This ")_"file"
+3 SET LEXT=LEXT_$SELECT(LEXMOD>1:"s ",1:" ")
+4 SET LEXT=LEXT_"contain"_$SELECT(LEXMOD>1:" ",1:"s ")
+5 SET LEXT=LEXT_"fields that may be modified at the site."
+6 DO BL^LEXXFI8
DO TL^LEXXFI8(LEXT)
+7 SET LEXT=" The Checksum"_$SELECT(LEXMOD>1:"s ",1:" ")
+8 SET LEXT=LEXT_"for "_$SELECT(LEXMOD>1:"these ",1:"this ")
+9 SET LEXT=LEXT_"file"_$SELECT(LEXMOD>1:"s ",1:" ")
+10 SET LEXT=LEXT_"may vary from site to site."
+11 DO TL^LEXXFI8(LEXT)
+12 QUIT
BL ; Blank Line
+1 NEW LEXI,LEXT
SET LEXI=+($ORDER(^TMP("LEXCS",$JOB," "),-1))
SET LEXT=$GET(^TMP("LEXCS",$JOB,+LEXI))
+2 if (LEXI+1)'>1
QUIT
if LEXT'=" "
DO TL(" ")
+3 QUIT
TL(X) ; Text Line
+1 SET X=$GET(X)
if '$DATA(ZTQUEUED)
WRITE !,X
+2 NEW LEXI
SET LEXI=+($ORDER(^TMP("LEXCS",$JOB," "),-1))+1
SET ^TMP("LEXCS",$JOB,LEXI)=X
SET ^TMP("LEXCS",$JOB,0)=LEXI
+3 QUIT
TT(X,Y) ; Title Line
+1 NEW LEXFI,LEXTT,LEXT,LEXN,LEXNM
SET LEXFI=$GET(X)
SET LEXTT=$GET(Y)
if +($$IF(LEXFI))'>0
SET LEXFI=""
+2 if +LEXFI>0
SET LEXNM=$$FN(LEXFI)_" File (#"_+LEXFI_")"
if +LEXFI'>0
SET LEXNM="Lexicon/ICD/CPT File"
+3 SET LEXT=" "_LEXNM_" "_$GET(LEXTT)
if +($GET(LEXMUL))>0&($EXTRACT(LEXT,$LENGTH(LEXT))'="s")
SET LEXT=LEXT_"s"
+4 DO BL
DO TL(LEXT)
SET $PIECE(LEXN,"=",$LENGTH(LEXT))=""
SET LEXN=" "_LEXN
DO TL(LEXN)
+5 QUIT
IF(X) ; Is File on the List of Files
+1 NEW LEXTAG,LEXRTN,LEXCTR,LEXCTL,LEXFI,LEXLINE,LEXOK
SET LEXCTL=$GET(X)
if '$LENGTH(LEXCTL)
QUIT 0
if +LEXCTL'>0
QUIT 0
+2 SET LEXFI=""
SET LEXTAG="FILES"
SET LEXRTN="LEXXFI"
SET (LEXCTR,LEXOK)=0
+3 FOR
Begin DoDot:1
+4 SET LEXCTR=LEXCTR+1
+5 SET LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")"
XECUTE LEXEX
+6 SET LEXFI=$PIECE(LEXLINE,";;",2,3)
SET LEXFI=$PIECE(LEXFI,";;",2)
+7 if '$LENGTH(LEXFI)
QUIT
if +LEXFI=+LEXCTL
SET LEXOK=1
End DoDot:1
if LEXFI=""
QUIT
if +LEXOK>0
QUIT
+8 SET X=LEXOK
+9 QUIT X
