LEXXFI8 ; ISL/KER - File Info - Miscellaneous ; 07/28/2004 ;;2.0;LEXICON UTILITY;**32**;Sep 23, 1996;Build 1 Q ; ; Global Variables ; ^TMP("LEXCS",$J SACC 2.3.2.5.1 ; ^TMP("LEXINS",$J SACC 2.3.2.5.1 ; ; External References ; DBIA 10003 ^%DT ; DBIA 10022 %XY^%RCR ; DBIA 10006 ^DIC (file 4.2 and 9.4) ; DBIA 10006 IX^DIC ; DBIA 2052 FILE^DID ; DBIA 2056 $$GET1^DIQ (file 81.2) ; DBIA 10103 $$FMTE^XLFDT ; 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.MED.VA.GOV" D ^DIC Q:+Y>0 LEX S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="ISC-SLC.MED.VA.GOV" D ^DIC Q:+Y>0 LEX Q "ISC-SLC.VA.GOV" 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