source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBACSV.m@ 949

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

initial load of WorldVistAEHR

File size: 5.3 KB
RevLine 
[613]1IBACSV ;WOIFO/AAT-CODE SET VERSIONING IB UTILITIES ;19-FEB-03
2 ;;2.0;INTEGRATED BILLING;**210,266**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6 ;
7 ;*** DD calls ***
8 ; Called from Data Dictionary of 399, subfile 399.30416, field .02
9B30416 ;
10 S ICPTVDT=$$BDATE($G(DA(2)),$G(DA(1))) ; Date of service
11 S DIC("S")="I $$MODP^ICPTMOD(+$G(^DGCR(399,DA(2),""CP"",DA(1),0)),+Y,""I"",ICPTVDT)>0"
12 S DIC("W")="D EN^DDIOL("" ""_$P($$MOD^ICPTMOD(+Y,""I"",ICPTVDT),U,3),,""?0"")"
13 Q
14 ;
15 ;*** API calls ***
16 ;
17 ;Returns data of the CPT code, NULL if error
18 ;Input: IBC-code, IBDT-date (default is today)
19 ;Output: (by reference) - IBERROR - error string if error happened
20 ;DO NOT USE THIS CALL TO DETERMINE ACTIVE/INACTIVE STATUS OF THE CODE
21CPT(IBC,IBDT,IBERROR) N IBINF
22 I '$G(IBDT) S IBDT=DT
23 S IBERROR=""
24 S IBINF=$$CPT^ICPTCOD(IBC,IBDT,1) ;Local codes supported
25 I IBINF<0 S IBERROR=$P(IBINF,U,2),IBINF=""
26 Q $P(IBINF,U,2,999) ;Remove the first piece (IEN)
27 ;
28 ;Returns data of the ICD Operational code, NULL if error
29 ;Input: IBC-code, IBDT-date (default is today)
30 ;Output: (by reference) - IBERROR - error string if error happened
31 ;DO NOT USE THIS CALL TO DETERMINE ACTIVE/INACTIVE STATUS OF THE CODE
32ICD0(IBC,IBDT,IBERROR) N IBINF
33 I '$G(IBDT) S IBDT=DT
34 S IBERROR=""
35 S IBINF=$$ICDOP^ICDCODE(IBC,IBDT,,1) ;Local codes supported
36 I IBINF<0 S IBERROR=$P(IBINF,U,2),IBINF=""
37 Q $P(IBINF,U,2,999) ;Remove the first piece (IEN)
38 ;
39 ;Returns data of the ICD Diagnosis code, NULL if error
40 ;Input: IBC-code, IBDT-date (default is today)
41 ;Output: (by reference) - IBERROR - error string if error happened
42 ;DO NOT USE THIS CALL TO DETERMINE ACTIVE/INACTIVE STATUS OF THE CODE
43ICD9(IBC,IBDT,IBERROR) N IBINF
44 I '$G(IBDT) S IBDT=DT
45 S IBERROR=""
46 S IBINF=$$ICDDX^ICDCODE(IBC,IBDT,,1) ; Local codes supported
47 I IBINF<0 S IBERROR=$P(IBINF,U,2),IBINF=""
48 Q $P(IBINF,U,2,999) ;Remove the first piece (IEN)
49 ;
50 ;Returns data of the DRG code, NULL if error
51 ;Input: IBC-code, IBDT-date (default is today)
52 ;Output: (by reference) - IBERROR - error string if error happened
53DRG(IBC,IBDT,IBERROR) N IBINF
54 I '$G(IBDT) S IBDT=DT
55 S IBERROR=""
56 S IBINF=$$DRG^ICDGTDRG(IBC,IBDT)
57 I IBINF<0 S IBERROR=$P(IBINF,U,2),IBINF=""
58 Q IBINF ;Format of the DRG API is different - the first piece doesn't need to be removed.
59 ;
60 ;
61 ; ==== Determine Active Status for CPT,ICD0,ICD9 and DRG codes ====
62 ;Used by DD for screening CPT codes
63 ;Is the given code active for the date? (default-today)
64CPTACT(IEN,IBDT) N IBINF,IBRES
65 I '$G(IBDT) S IBDT=DT
66 S IBRES=0
67 S IBINF=$$CPT^ICPTCOD(IEN,IBDT)
68 I IBINF'<0,$P(IBINF,U,7) S IBRES=1
69 Q IBRES
70 ;
71 ;Is the given code active for the date? (default-today)
72ICD0ACT(IEN,IBDT) N IBINF,IBRES
73 I '$G(IBDT) S IBDT=DT
74 S IBRES=0
75 S IBINF=$$ICDOP^ICDCODE(IEN,IBDT)
76 I IBINF'<0,$P(IBINF,U,10) S IBRES=1
77 Q IBRES
78 ;
79 ;Is the given code active for the date? (default-today)
80ICD9ACT(IEN,IBDT) N IBINF,IBRES
81 I '$G(IBDT) S IBDT=DT
82 S IBRES=0
83 S IBINF=$$ICDDX^ICDCODE(IEN,IBDT)
84 I IBINF'<0,$P(IBINF,U,10) S IBRES=1
85 Q IBRES
86 ;
87 ;Is the given code active for the date? (default-today)
88DRGACT(IEN,IBDT) N IBINF,IBRES
89 I '$G(IBDT) S IBDT=DT
90 S IBRES=0
91 S IBINF=$$DRG^ICDGTDRG(IEN,IBDT)
92 I IBINF'<0,$P(IBINF,U,14) S IBRES=1
93 Q IBRES
94 ;
95 ; ==== Determine Record Number (IEN) for CPT, ICD0, ICD9 and DRG codes ====
96 ; Note: the Date of Service doesn't matter here!
97 ;Input: IBC-name
98 ;Returns: IEN of the code (or NULL if not valid)
99CPTIEN(IBC) N IBINF,IBRES
100 S IBRES=""
101 S IBINF=$$CPT^ICPTCOD(IBC)
102 I IBINF>0 S IBRES=$P(IBINF,U)
103 Q IBRES
104 ;
105 ;Input: IBC-name
106 ;Returns: IEN of the code (or NULL if not valid)
107ICD0IEN(IBC) N IBINF,IBRES
108 S IBRES=""
109 S IBINF=$$ICDOP^ICDCODE(IBC)
110 I IBINF>0 S IBRES=$P(IBINF,U)
111 Q IBRES
112 ;
113 ;Input: IBC-name
114 ;Returns: IEN of the code (or NULL if not valid)
115ICD9IEN(IBC) N IBINF,IBRES
116 S IBRES=""
117 S IBINF=$$ICDDX^ICDCODE(IBC)
118 I IBINF>0 S IBRES=$P(IBINF,U)
119 Q IBRES
120 ;
121 ;Input: IBC-name
122 ;Returns: IEN of the code (or NULL if not valid)
123DRGIEN(IBC) N IBINF,IBRES
124 S IBRES=""
125 S IBINF=$$DRG^ICDGTDRG(IBC)
126 I IBINF'<0 S IBRES=$P(IBINF,U,17)
127 Q IBRES
128 ;
129 ; ==== Bill's Date of Service (for diagnosis codes, revenue codes) ====
130 ; Th EVENT DATE of the bill is used as a date of service for CSV
131BDATE(IBIFN,PROC) ;
132 ; PROC (Optional) - IEN of PROCEDURES sub-file.
133 ; if PROC is defined, the function will try to return the date of procedure first.
134 N IBDAT
135 S IBDAT=""
136 I '$G(IBIFN) Q ""
137 ; The following line of code is for entering new procedures.
138 ; If PROC is defined, but NULL - that means adding new procedure to 399.
139 ; Therefore we try to use DGPROCDT variable prior to the bill's Event Date
140 I $D(PROC),'PROC,$G(DGPROCDT)>0 S IBDAT=DGPROCDT
141 I $G(PROC) S IBDAT=$P($P($G(^DGCR(399,+IBIFN,"CP",+PROC,0)),U,2),".")
142 I 'IBDAT S IBDAT=$P($P($G(^DGCR(399,+IBIFN,0)),U,3),".")
143 Q $S(IBDAT>0:IBDAT,1:"")
144 ;
145 ; === PTF Date of Service ===
146PTFDATE(IBPTF) ;
147 I '$G(IBPTF) Q ""
148 Q $$GETDATE^ICDGTDRG(+$G(IBPTF))
149 ;
150 ; === Date of service, associated with the Tracking Number ===
151TRNDATE(IBTRN) ; The EPISODE DATE is used to determine the date of service
152 ; for the given Tracking Number
153 I '$G(IBTRN) Q ""
154 Q $P($P($G(^IBT(356,+IBTRN,0)),U,6),".")
155 ;
156 ; === DRG Text Descriptor (1st line only) ===
157DRGTD(IEN,IBDT) ;
158 N IBARR,IBRES
159 S IBDT=$P($G(IBDT),".")
160 I $T(DRGD^ICDGTDRG)="" Q $G(^ICD(+IEN,1,1,0))
161 S IBRES=$$DRGD^ICDGTDRG(IEN,"IBARR",,IBDT)
162 Q $G(IBARR(1))
163 ;
Note: See TracBrowser for help on using the repository browser.