source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXXFI8.m@ 1064

Last change on this file since 1064 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.1 KB
RevLine 
[613]1LEXXFI8 ; ISL/KER - File Info - Miscellaneous ; 07/28/2004
2 ;;2.0;LEXICON UTILITY;**32**;Sep 23, 1996;Build 1
3 Q
4 ;
5 ; Global Variables
6 ; ^TMP("LEXCS",$J SACC 2.3.2.5.1
7 ; ^TMP("LEXINS",$J SACC 2.3.2.5.1
8 ;
9 ; External References
10 ; DBIA 10003 ^%DT
11 ; DBIA 10022 %XY^%RCR
12 ; DBIA 10006 ^DIC (file 4.2 and 9.4)
13 ; DBIA 10006 IX^DIC
14 ; DBIA 2052 FILE^DID
15 ; DBIA 2056 $$GET1^DIQ (file 81.2)
16 ; DBIA 10103 $$FMTE^XLFDT
17 ;
18LEX(X) ; LEX* File
19 N LEXN S X=$G(X) Q:+X=0 0 S LEXN=$$GL(X) Q:$E(LEXN,1,4)="^LEX" 1
20 Q 0
21IC(X) ; IC* File
22 S X=$G(X) I "^80^80.1^80.2^80.3^81^81.1^81.3^"[("^"_+X_"^") Q 1
23 Q 0
24GL(X) ; Global Location
25 N DIERR,LEXE,LEXN S X=$G(X) Q:+X=0 "" D FILE^DID(+X,"N","GLOBAL NAME","LEXN","LEXE")
26 S X="" S:'$D(DIERR) X=$G(LEXN("GLOBAL NAME"))
27 Q X
28FN(X) ; File Name
29 N DIERR,LEXE,LEXN S X=$G(X) D FILE^DID(+X,"N","NAME","LEXN","LEXE")
30 S X="" S:'$D(DIERR) X=$G(LEXN("NAME"))
31 Q X
32INS(X) ; Installed
33 N %X,%Y,LEXFI,LEXIN,LEXPH,LEXPK,LEXPV,LEXRV,LEXSQ,LEXVR K ^TMP("LEXINS",$J)
34 S LEXFI=+($G(X)) Q:+LEXFI'>0 ""
35 S LEXVR=$P($$VR(LEXFI),"^",1) Q:'$L(LEXVR) "" Q:+LEXVR'>0 ""
36 S LEXRV=$P($$RV(LEXFI),"^",1) Q:'$L(LEXRV) "" Q:+LEXRV'>0 ""
37 S LEXPK=$$PKG(LEXFI) Q:'$L(LEXPK) "" Q:+LEXPK'>0 ""
38 S LEXPV=$$PH(LEXPK,LEXVR) Q:+LEXPV'>0 ""
39 S %X="^DIC(9.4,"_LEXPK_",22,"_LEXPV_",""PAH"",",%Y="^TMP(""LEXINS"","_$J_",""PAH""," D %XY^%RCR
40 S LEXPH=$O(^TMP("LEXINS",$J,"PAH","B",LEXRV,0)) I LEXPH'>0 D
41 . S LEXPH="",LEXSQ=$O(^TMP("LEXINS",$J,"PAH","B",(LEXRV_" ")))
42 . Q:'$L(LEXSQ) Q:$E(LEXSQ,1,$L(LEXRV))'=LEXRV
43 . S LEXPH=$O(^TMP("LEXINS",$J,"PAH","B",LEXSQ,0))
44 S LEXIN=$P($P($G(^TMP("LEXINS",$J,"PAH",+LEXPH,0)),"^",2),".",1)
45 S X=$S(+LEXIN>0:$$SD(+LEXIN),1:"") S:$L(X)'=10 X=""
46 K ^TMP("LEXINS",$J)
47 Q X
48VR(X) ; File Version
49 N DIERR,LEXCDT,LEXE,LEXEX,LEXFI,LEXL,LEXN,LEXRTN,LEXVR,LEXVRD
50 S LEXFI=$G(X) N DIERR,LEXN,LEXNM,LEXE,LEXEX,LEXL,LEXRTN
51 D FILE^DID(+LEXFI,"N","VERSION","LEXN","LEXE") S LEXVR="" I '$D(DIERR) D
52 . S LEXVR=$G(LEXN("VERSION")) S LEXRTN=$S($P(+LEXFI,".",1)=757:"LEXA",$P(+LEXFI,".",1)=80:"ICDCODE",$P(+LEXFI,".",1)=81:"ICPTCOD",1:"")
53 . Q:'$L(LEXRTN) S LEXEX="S LEXL=$T(+2^"_LEXRTN_")" X LEXEX
54 . Q:'$L(LEXL) I $P(LEXL,";",3)=LEXVR,$L($P(LEXL,";",6)) S LEXVRD=$$LTS($P(LEXL,";",6))
55 S LEXCDT="" S:LEXFI=81.2 LEXCDT=$$DDT
56 S X=$G(LEXVR) S:$L($G(LEXVR))&($L($G(LEXVRD))) X=X_"^"_$G(LEXVRD)
57 S:$L($G(LEXVR))&($L($G(LEXVRD)))&($L(LEXCDT)) X=X_"^"_$G(LEXCDT)
58 Q X
59RV(X) ; File Revision
60 N DIERR,LEXE,LEXN S X=$G(X)
61 D FILE^DID(+X,"N","PACKAGE REVISION DATA","LEXN","LEXE")
62 S X="" S:'$D(DIERR) X=$G(LEXN("PACKAGE REVISION DATA"))
63 S:+$P(X,"^",2) $P(X,"^",2)=$$SD($P(X,"^",2))
64 Q X
65DDT(X) ; CPT Distribution Date
66 N LEXDDT S LEXDDT=$$GET1^DIQ(81.2,"1,",.02,"I") Q:'$L(LEXDDT) "" Q:+LEXDDT'>0 "" S X=$$SD(LEXDDT)
67 Q X
68ADR(LEX) ; Mailing Address
69 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
70 S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="ISC-SLC.MED.VA.GOV" D ^DIC Q:+Y>0 LEX
71 Q "ISC-SLC.VA.GOV"
72MX(X) ; Mix Case
73 Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
74LTS(X) ; Long to Short Date
75 N %DT,Y S X=$G(X) Q:'$L(X) "" S %DT="T" D ^%DT S X=$$SD(Y)
76 Q X
77SD(X) ; Short Date
78 S X=$G(X),X=$TR($$FMTE^XLFDT($P(X,".",1),"5DZ"),"@"," ")
79 Q X
80PKG(X) ; Package
81 N D,DIC,DTOUT,DUOUT,LEXFI,LEXN S LEXFI=+($G(X)) Q:+LEXFI'>0 ""
82 S LEXN=$S($P(LEXFI,".",1)=757:"LEXICON UTILITY",$P(LEXFI,".",1)=80:"DRG GROUPER",$P(LEXFI,".",1)=81:"CPT/HCPCS CODES",1:"")
83 Q:'$L(LEXN) N X,Y S DIC="^DIC(9.4,",D="B",DIC(0)="X",X=LEXN D IX^DIC
84 S X=+($G(Y))
85 Q X
86PH(X,Y) ; Patch History
87 N DA,DIC,DTOUT,DUOUT,LEXPK,LEXVR
88 S (DA(1),LEXPK)=+($G(X)) Q:+LEXPK'>0 "" S LEXVR=$G(Y) Q:'$L(LEXVR) "" Q:+LEXVR'>0 ""
89 S DIC="^DIC(9.4,"_DA(1)_",22,",X=LEXVR,DIC(0)="X"
90 D ^DIC S X=+($G(Y)) S:+Y'>0 X=""
91 Q X
92TIC(X) ; Time
93 Q $$NOW^XLFDT
94ELAP(X,Y) ; Elapsed Time (start,end)
95 Q $TR($$FMDIFF^XLFDT(+($G(Y)),+($G(X)),3)," ","0")
96LDR(X) ; Leader
97 N LEXFI,LEXMOD S LEXFI=+($G(X)) Q:LEXFI'>0 0 S LEXMOD=$$MOD(LEXFI),X=$S(+LEXMOD>0:" * ",1:" ")
98 Q X
99MOD(X) ; Modifier File
100 N LEXFI,LEXSRC,LEXE,LEXTAG,LEXRTN,LEXCTR,LEXLDR,LEXMOD
101 S LEXSRC=+($G(X)) Q:LEXSRC'>0 0
102 S LEXFI="",LEXE=0,LEXTAG="FILES",LEXRTN="LEXXFI",LEXCTR=0,LEXMOD=0
103 F D Q:LEXFI="" Q:+LEXE>0
104 . S LEXCTR=LEXCTR+1
105 . S LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")" X LEXEX
106 . S LEXFI=$P(LEXLINE,";;",2,3)
107 . S LEXLDR=$P(LEXFI,";;",1),LEXFI=$P(LEXFI,";;",2)
108 . Q:'$L(LEXFI) Q:+LEXFI'=LEXSRC
109 . S LEXMOD=$S(+LEXLDR>0:1,1:0) S:LEXMOD>0 LEXE=1
110 S X=LEXMOD
111 Q X
112MF(X) ; Modified Files
113 N LEXMOD,LEXT S LEXMOD=+($G(X)) Q:LEXMOD'>0
114 S LEXT=" * "_$S(LEXMOD>1:"These ",1:"This ")_"file"
115 S LEXT=LEXT_$S(LEXMOD>1:"s ",1:" ")
116 S LEXT=LEXT_"contain"_$S(LEXMOD>1:" ",1:"s ")
117 S LEXT=LEXT_"fields that may be modified at the site."
118 D BL^LEXXFI8,TL^LEXXFI8(LEXT)
119 S LEXT=" The Checksum"_$S(LEXMOD>1:"s ",1:" ")
120 S LEXT=LEXT_"for "_$S(LEXMOD>1:"these ",1:"this ")
121 S LEXT=LEXT_"file"_$S(LEXMOD>1:"s ",1:" ")
122 S LEXT=LEXT_"may vary from site to site."
123 D TL^LEXXFI8(LEXT)
124 Q
125BL ; Blank Line
126 N LEXI,LEXT S LEXI=+($O(^TMP("LEXCS",$J," "),-1)),LEXT=$G(^TMP("LEXCS",$J,+LEXI))
127 Q:(LEXI+1)'>1 D:LEXT'=" " TL(" ")
128 Q
129TL(X) ; Text Line
130 S X=$G(X) W:'$D(ZTQUEUED) !,X
131 N LEXI S LEXI=+($O(^TMP("LEXCS",$J," "),-1))+1,^TMP("LEXCS",$J,LEXI)=X,^TMP("LEXCS",$J,0)=LEXI
132 Q
133TT(X,Y) ; Title Line
134 N LEXFI,LEXTT,LEXT,LEXN,LEXNM S LEXFI=$G(X),LEXTT=$G(Y) S:+($$IF(LEXFI))'>0 LEXFI=""
135 S:+LEXFI>0 LEXNM=$$FN(LEXFI)_" File (#"_+LEXFI_")" S:+LEXFI'>0 LEXNM="Lexicon/ICD/CPT File"
136 S LEXT=" "_LEXNM_" "_$G(LEXTT) S:+($G(LEXMUL))>0&($E(LEXT,$L(LEXT))'="s") LEXT=LEXT_"s"
137 D BL,TL(LEXT) S $P(LEXN,"=",$L(LEXT))="",LEXN=" "_LEXN D TL(LEXN)
138 Q
139IF(X) ; Is File on the List of Files
140 N LEXTAG,LEXRTN,LEXCTR,LEXCTL,LEXFI,LEXLINE,LEXOK S LEXCTL=$G(X) Q:'$L(LEXCTL) 0 Q:+LEXCTL'>0 0
141 S LEXFI="",LEXTAG="FILES",LEXRTN="LEXXFI",(LEXCTR,LEXOK)=0
142 F D Q:LEXFI="" Q:+LEXOK>0
143 . S LEXCTR=LEXCTR+1
144 . S LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")" X LEXEX
145 . S LEXFI=$P(LEXLINE,";;",2,3),LEXFI=$P(LEXFI,";;",2)
146 . Q:'$L(LEXFI) S:+LEXFI=+LEXCTL LEXOK=1
147 S X=LEXOK
148 Q X
Note: See TracBrowser for help on using the repository browser.