source: WorldVistAEHR/trunk/r/DRG_GROUPER-ICD--ICPT/ICDID.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1ICDID ;SLC/KER - ICD IDENTIFIERS ; 04/18/2004
2 ;;18.0;DRG Grouper;**12,15**;Oct 20, 2000;Build 1
3 ;
4 ;
5 ; External References
6 ; DBIA 2056 $$GET1^DIQ
7 ; DBIA 10103 $$DT^XLFDT
8 ;
9 Q
10 ; Versioned Identifiers use the following
11 ; input parameters:
12 ;
13 ; Y Fileman's Internal Entry Number
14 ; X DD Field Number
15 ;
16 ; Format for using Identifiers
17 ;
18 ; ^DD(file,0,"ID",field)=
19 ; D EN^DDIOL((" "_$$IDDX^ICDID(+Y,field)),"","?0")
20 ;
21IDDX(Y,X) ; ICD Diagnosis Identifiers (versioned)
22 N FLD,MSG,CODE S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 "" Q:+Y'>0 ""
23 I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
24 S MSG=$$MSG^ICDAPIU($G(ICDVDT)),CODE=$P($G(^ICD9(+Y,0)),U,1)
25 I FLD=3 S X=$$VSTD^ICDCODE(+Y,$G(ICDVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
26 I FLD=10 S X=$$VLTD^ICDCODE(+Y,$G(ICDVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
27 I FLD=100 S X=$$STA(+($$STATCHK^ICDAPIU(CODE,$G(ICDVDT)))) Q X
28 I FLD=20!(FLD=30)!(FLD=40)!(FLD=66)!(FLD=67)!(FLD=68) Q ""
29 S X=$$GET1^DIQ(80,(+($G(Y))_","),FLD)
30 Q X
31IDDXS(Y) ; ICD Diagnosis Identifiers (versioned - short)
32 N ICID,MSG,CODE,ST,ND,CC,X S Y=+($G(Y)) Q:+Y'>0 "" S ND=$G(^ICD9(+Y,0))
33 I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
34 S MSG=$$MSG^ICDAPIU($G(ICDVDT)) S:MSG["CODE " MSG="Text may be inaccurate"
35 S CODE=$P(ND,U,1)
36 S ICID=$$VSTD^ICDCODE(+Y,$G(ICDVDT)) S:$L(MSG) ICID=ICID_" ("_MSG_")"
37 S ST=$$STA(+($$STATCHK^ICDAPIU(CODE,$G(ICDVDT))))
38 S CC=+$P(ND,U,7),CC=$S(CC>0:"C/C",1:"")
39 S:$L(CC) ICID=ICID_$S('$L(MSG):" ",1:"")_"("_CC_")"
40 S:$L(ST) ICID=ICID_$S('$L(MSG)&('$L(CC)):" ",1:"")_" "_ST
41 F Q:$E(ICID,1)'=" " S ICID=$E(ICID,2,$L(ICID))
42 S Y=ICID
43 Q Y
44IDOP(Y,X) ; ICD Procedure Identifiers (versioned)
45 N FLD,MSG,CODE S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 "" Q:+Y'>0 ""
46 I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
47 S MSG=$$MSG^ICDAPIU($G(ICDVDT)),CODE=$P($G(^ICD0(+Y,0)),U,1)
48 I FLD=4 S X=$$VSTP^ICDCODE(+Y,$G(ICDVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
49 I FLD=10 S X=$$VLTP^ICDCODE(+Y,$G(ICDVDT))_$S($L(MSG):(" ("_MSG_")"),1:"") Q X
50 I FLD=100 S X=$$STA(+($$STATCHK^ICDAPIU(CODE,$G(ICDVDT)))) Q X
51 I FLD=7!(FLD=66)!(FLD=67)!(FLD=68) Q ""
52 S X=$$GET1^DIQ(80.1,(+($G(Y))_","),FLD)
53 Q X
54IDOPS(Y) ; ICD Procedure Identifiers (versioned - short)
55 N ICID,MSG,CODE,ST,X S Y=+($G(Y)) Q:+Y'>0 ""
56 I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
57 S MSG=$$MSG^ICDAPIU($G(ICDVDT)) S:MSG["CODE " MSG="Text may be inaccurate"
58 S CODE=$P($G(^ICD0(+Y,0)),U,1)
59 S ICID=$$VSTP^ICDCODE(+Y,$G(ICDVDT)) S:$L(MSG) ICID=ICID_" ("_MSG_")"
60 S ST=$$STA(+($$STATCHK^ICDAPIU(CODE,$G(ICDVDT))))
61 S:$L(ST) ICID=ICID_$S('$L(MSG):" ",1:"")_" "_ST
62 F Q:$E(ICID,1)'=" " S ICID=$E(ICID,2,$L(ICID))
63 S Y=ICID
64 Q Y
65IDDG(Y,X) ; DRG Identifiers (versioned)
66 N FLD,MSG S FLD=+($G(X)),Y=+($G(Y)) Q:+FLD'>0 "" Q:+Y'>0 ""
67 I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
68 S MSG=$$MSG^ICDAPIU($G(ICDVDT)) I FLD=1 D Q X
69 . N DRG D VLTDR^ICDGTDRG(+Y,$G(ICDVDT),.DRG)
70 . S X=$G(DRG(1)) S:$L(MSG) X=X_" ("_MSG_")"
71 I FLD=15 D Q X
72 . N VD,I,ST S VD=$O(^ICD(+Y,66,"B"," "),-1)
73 . S I=$O(^ICD(+Y,66,"B",+VD," "),-1),X=$$STA(+($P($G(^ICD(+Y,66,+I,0)),U,3)))
74 I FLD=20!(FLD=30)!(FLD=66)!(FLD=68) Q ""
75 S X=$$GET1^DIQ(80.2,(+($G(Y))_","),FLD)
76 Q X
77IDDGS(Y) ; DRG Identifiers (versioned - Short)
78 N MSG,X,ICDRG,ICID,VD,I,ST S Y=+($G(Y)) Q:+Y'>0 ""
79 I '$D(ICDVDT) N ICDVDT S ICDVDT=$$DT^XLFDT
80 S MSG=$$MSG^ICDAPIU($G(ICDVDT)) S:MSG["CODE " MSG="Text may be inaccurate"
81 D VLTDR^ICDGTDRG(+Y,$G(ICDVDT),.ICDRG)
82 S ICID=$G(ICDRG(1)) S:$L(MSG) ICID=ICID_" ("_MSG_")"
83 S VD=$O(^ICD(+Y,66,"B"," "),-1)
84 S I=$O(^ICD(+Y,66,"B",+VD," "),-1)
85 S ST=$$STA(+($P($G(^ICD(+Y,66,+I,0)),U,3)))
86 S:$L(ST) ICID=ICID_$S('$L(MSG):" ",1:"")_" "_ST
87 F Q:$E(ICID,1)'=" " S ICID=$E(ICID,2,$L(ICID))
88 S Y=ICID
89 Q Y
90STA(X) ; Status
91 Q $S(+($G(X)):"",1:"INACTIVE")
Note: See TracBrowser for help on using the repository browser.