source: WorldVistAEHR/trunk/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTID.m@ 1374

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1ICPTID ;SLC/KER - CPT IDENTIFIERS ; 04/18/2004
2 ;;6.0;CPT/HCPCS;**19**;May 19, 1997;Build 1
3 ;
4 ; External References
5 ; DBIA 2056 $$GET1^DIQ
6 ; DBIA 10103 $$DT^XLFDT
7 ;
8 Q
9 ; Versioned Identifiers use the following
10 ; input parameters:
11 ;
12 ; X Fileman's Internal Entry Number
13 ; Y DD Field Number
14 ;
15 ; Format for using Identifiers
16 ;
17 ; ^DD(file,0,"ID",field)=
18 ; D EN^DDIOL((" "_$$IDCP^ICPTID(+Y,field)),"","?0")
19 ;
20IDCP(Y,X) ; CPT/HCPCS Identifiers (versioned)
21 N FLD,MSG,CODE S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 "" Q:+Y'>0 ""
22 S:'$D(DT) DT=$$DT^XLFDT I '$D(ICPTVDT) N ICPTVDT S ICPTVDT=DT
23 S MSG=$$MSG^ICPTSUPT($G(ICPTVDT),1),CODE=$P($G(^ICPT(+Y,0)),U,1)
24 I FLD=2 S X=$$VSTCP^ICPTCOD(+Y,$G(ICPTVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
25 I FLD=5 S X=$$STA(+($$STATCHK^ICPTAPIU(CODE,$G(ICPTVDT)))) Q X
26 I FLD=50!(FLD=60)!(FLD=61)!(FLD=62) Q ""
27 S X=$$GET1^DIQ(81,(+($G(Y))_","),FLD)
28 Q X
29IDCPS(Y) ; CPT/HCPCS Identifiers (versioned - short)
30 N ICID,MSG,CODE,ST,X S Y=+($G(Y)) Q:+Y'>0 ""
31 S:'$D(DT) DT=$$DT^XLFDT I '$D(ICPTVDT) N ICPTVDT S ICPTVDT=DT
32 S MSG=$$MSG^ICPTSUPT($G(ICPTVDT),1) S:MSG["CODE " MSG="Text may be inaccurate"
33 S CODE=$P($G(^ICPT(+Y,0)),U,1)
34 S ICID=$$VSTCP^ICPTCOD(+Y,$G(ICPTVDT)) S:$L(MSG) ICID=ICID_" ("_MSG_")"
35 S ST=$$STA(+($$STATCHK^ICPTAPIU(CODE,$G(ICPTVDT))))
36 S:$L(ST) ICID=ICID_$S('$L(MSG):" ",1:"")_" "_ST
37 F Q:$E(ICID,1)'=" " S ICID=$E(ICID,2,$L(ICID))
38 S Y=ICID
39 Q Y
40IDMD(Y,X) ; CPT Modifier Identifiers (versioned)
41 N FLD,MSG,CODE S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 "" Q:+Y'>0 ""
42 S:'$D(DT) DT=$$DT^XLFDT I '$D(ICPTVDT) N ICPTVDT S ICPTVDT=DT
43 S MSG=$$MSG^ICPTSUPT($G(ICPTVDT),1)
44 I FLD=.02 S X=$$VSTCM^ICPTMOD(+Y,$G(ICPTVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
45 I FLD=5 D Q X
46 . N VD,I S VD=$O(^DIC(81.3,+Y,60,"B"," "),-1)
47 . S I=+($O(^DIC(81.3,+Y,60,"B",+VD," "),-1))
48 . S X=$$STA(+($P($G(^DIC(81.3,+Y,60,+I,0)),U,2)))
49 I FLD=10!(FLD=50)!(FLD=60)!(FLD=61)!(FLD=62) Q ""
50 S X=$$GET1^DIQ(81.3,(+($G(Y))_","),FLD)
51 Q X
52IDMDS(Y) ; CPT Modifier Identifiers (versioned - short)
53 N ICID,MSG,CODE,ST,X,VD,VI S Y=+($G(Y)) Q:+Y'>0 ""
54 S:'$D(DT) DT=$$DT^XLFDT I '$D(ICPTVDT) N ICPTVDT S ICPTVDT=DT
55 S MSG=$$MSG^ICPTSUPT($G(ICPTVDT),1) S:MSG["CODE " MSG="Text may be inaccurate"
56 S ICID=$$VSTCM^ICPTMOD(+Y,$G(ICPTVDT)) S:$L(MSG) ICID=ICID_" ("_MSG_")"
57 S VD=$O(^DIC(81.3,+Y,60,"B"," "),-1)
58 S VI=+($O(^DIC(81.3,+Y,60,"B",+VD," "),-1))
59 S ST=$$STA(+($P($G(^DIC(81.3,+Y,60,+VI,0)),U,2)))
60 S:$L(ST) ICID=ICID_$S('$L(MSG):" ",1:"")_" "_ST
61 F Q:$E(ICID,1)'=" " S ICID=$E(ICID,2,$L(ICID))
62 S Y=ICID
63 Q Y
64STA(X) ; Status
65 Q $S(+($G(X)):"",1:"INACTIVE")
Note: See TracBrowser for help on using the repository browser.