source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAUTL4.m@ 1504

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

initial load of WorldVistAEHR
File size: 6.2 KB
Line 
1FBAAUTL4 ;AISC/CMR,dmk,WCIOFO/SAB-UTILITY ROUTINE ;7/11/2001
2 ;;3.5;FEE BASIS;**4,32,77,81**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CPT(X,Y,FBSRVDT) ;return external format of CPT code
6 ;INPUT X = ien of CPT
7 ;optional Y I Y return description, I 'Y return external format of CPT
8 ;optional FBSRVDT - date of service
9 ;OUTPUT external format of CPT code or description of CPT code
10 I '$G(X) Q ""
11 N Z
12 S Z=$$CPT^ICPTCOD(X,$S($G(FBSRVDT)>0:+$G(FBSRVDT),1:""),1)
13 Q $S('$G(Y):$P(Z,U,2),1:$P(Z,U,3))
14 ;
15MOD(X,Y,FBSRVDT) ;return external format of modifier
16 ;INPUT X = ien of modifier
17 ;optional Y I Y return description, I 'Y return external format of mod
18 ;optional FBSRVDT - date of service
19 ;OUTPUT external format of modifier or description of CPT code
20 I '$G(X) Q ""
21 N Z
22 S Z=$$MOD^ICPTMOD(X,"I",$S($G(FBSRVDT)>0:+$G(FBSRVDT),1:""),1)
23 Q $S('$G(Y):$P(Z,U,2),1:$P(Z,U,3))
24 ;
25CPTDATA(W,X,Y,Z) ;get internal value of CPT
26 ; input
27 ; W = IEN of PATIENT in file 162
28 ; X = IEN of VENDOR multiple in file 162
29 ; Y = IEN of INITIAL TREATMENT DATE multiple in file 162
30 ; Z = IEN of SERVICE PROVIDED multiple in file 162
31 ; returns
32 ; value of SERVICE PROVIDED (internal)
33 ;
34 I '$G(W)!('$G(X))!('$G(Y))!('$G(Z)) Q ""
35 Q $P($G(^FBAAC(W,1,X,1,Y,1,Z,0)),U)
36 ;
37MODDATA(W,X,Y,Z) ;get internal values of CPT Modifier
38 ; input
39 ; W = IEN of PATIENT in file 162
40 ; X = IEN of VENDOR multiple in file 162
41 ; Y = IEN of INITIAL TREATMENT DATE multiple in file 162
42 ; Z = IEN of SERVICE PROVIDED multiple in file 162
43 ; output
44 ; FBMODA( array of CPT MODIFIERs
45 ; FBMODA(#)=CPT MODIFIER (internal value)
46 ; where # is the IEN for an entry in the CPT MODIFIER multiple
47 K FBMODA
48 I '$G(W)!('$G(X))!('$G(Y))!('$G(Z)) Q
49 N FBI,FBMOD
50 S FBI=0 F S FBI=$O(^FBAAC(W,1,X,1,Y,1,Z,"M",FBI)) Q:'FBI D
51 . S FBMOD=$P($G(^FBAAC(W,1,X,1,Y,1,Z,"M",FBI,0)),U)
52 . Q:FBMOD=""
53 . S FBMODA(FBI)=FBMOD
54 Q
55 ;
56APS(FBJ,FBK,FBL,FBM) ; amount paid symbol
57 ; input
58 ; FBJ = IEN of PATIENT in file 162
59 ; FBK = IEN of VENDOR multiple in file 162
60 ; FBL = IEN of INITIAL TREATMENT DATE multiple in file 162
61 ; FBM = IEN of SERVICE PROVIDED multiple in file 162
62 ; returns symbol
63 ; where value is M (Mill Bill emergency care - 38 U.S.C. 1725)
64 ; R (RBRVS fee schedule amount)
65 ; F (VA fee schedule amount)
66 ; C (contracted service amount)
67 ; U (usual & customary - claimed)
68 ; null if no amount paid
69 N FBAP,FBRET,FBY0,FBY2
70 S FBRET=""
71 S FBY0=$G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0))
72 S FBY2=$G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,2))
73 S FBAP=$P(FBY0,U,3)
74 I FBAP>0 D
75 . ; use fee schedule info for payment (if any)
76 . I +FBAP=+$P(FBY2,U,12) S FBRET=$P(FBY2,U,13) Q:FBRET]""
77 . ; if no fee schedule info then calc 75th percentile and check
78 . I $P(FBY2,U,12)="" D Q:FBRET]""
79 . . S FBCPT=$$CPT($P(FBY0,U))
80 . . S FBMODL=$$MODL("^FBAAC("_FBJ_",1,"_FBK_",1,"_FBL_",1,"_FBM_",""M"")","E")
81 . . S FBDOS=$P($G(^FBAAC(FBJ,1,FBK,1,FBL,0)),U)
82 . . I +FBAP=+$$PRCTL^FBAAFSF(FBCPT,FBMODL,FBDOS) S FBRET="F"
83 . ; since not paid by a fee schedule, check prompt pay type
84 . I $P(FBY2,U,2) S FBRET="C" Q
85 . ; since not fee schedule or contract check POV code to identify
86 . ; Mill Bill payments
87 . S:"^39^52^"[(U_$P($G(^FBAA(161.82,+$P(FBY0,U,18),0)),U,3)_U) FBRET="M"
88 . Q:FBRET]""
89 . ; all other payments considered u&c
90 . S FBRET="U"
91 Q FBRET
92 ;
93CHKBI(X,Y) ;called to determine if batch number or invoice number
94 ;already exists
95 ;X= next batch/invoice number
96 ;Y=1 if Batch
97 ;Y undefined if invoice number passed
98 ;returns a truth if X is ok for next batch/invoice #
99 ;
100 I 'X Q ""
101 I $G(Y) Q $S($D(^FBAA(161.7,"B",X)):"",1:1)
102 I '$G(Y) Q $S($D(^FBAA(162.1,"B",X)):"",$D(^FBAAI("B",X)):"",$D(^FBAAC("C",X)):"",1:1)
103 ;
104MODL(FBAN,FBFLAG) ;return sorted list given array of modifiers
105 ; Input
106 ; FBAN - closed root of array containing modifiers
107 ; the data must be in nodes descendent from this root.
108 ; The subscripts of the nodes below FBAN must be
109 ; positive numbers. The CPT MODIFIER internal value
110 ; must be the first piece in these nodes or in the
111 ; 0-node descendent from these nodes.
112 ; i.e.
113 ; ARRAY(number)=CPT MODIFIER (internal value)
114 ; OR
115 ; ARRAY(number,0)=CPT MODIFIER (internal value)
116 ; FBFLAG - (optional) flag, E or I, default I
117 ; I to return internal values of modifiers
118 ; E to return external values of modifiers
119 ; Returns string of sorted modifiers (e.g. "1,3,7")
120 ;
121 N FBI,FBRET,FBSORT,FBX,FBZERO
122 S FBRET=""
123 S FBFLAG=$G(FBFLAG,"I")
124 ;
125 ; if any descendent data then determine if it is 0-node descendent
126 S FBZERO=0 I $O(@FBAN@(0)),$D(@FBAN@($O(@FBAN@(0)),0))#2 S FBZERO=1
127 ;
128 ; loop thru input array and place modifiers in a sort array
129 S FBI=0 F S FBI=$O(@FBAN@(FBI)) Q:'FBI D
130 . ; get the cpt modifier
131 . I FBZERO S FBX=$P(@FBAN@(FBI,0),U)
132 . E S FBX=$P(@FBAN@(FBI),U)
133 . I FBFLAG="E" D
134 . . ; convert to external value
135 . . S FBX=$$MOD^ICPTMOD(FBX,"I")
136 . . I FBX>0 S FBX=$P(FBX,U,2)
137 . . E S FBX=""
138 . I FBX]"" S FBSORT(FBX)=""
139 ;
140 ; loop thru sorted array and add the modifiers to return value
141 S FBX="" F S FBX=$O(FBSORT(FBX)) Q:FBX="" S FBRET=FBRET_","_FBX
142 ;
143 ; strip leading comma (if any)
144 I $E(FBRET)="," S FBRET=$E(FBRET,2,999)
145 ;
146 ; return value
147 Q FBRET
148 ;
149REPMOD(FBJ,FBK,FBL,FBM) ; Replace CPT Modifier(s) in payment
150 ; input
151 ; FBJ = IEN of PATIENT in file 162
152 ; FBK = IEN of VENDOR multiple in file 162
153 ; FBL = IEN of INITIAL TREATMENT DATE multiple in file 162
154 ; FBM = IEN of SERVICE PROVIDED multiple in file 162
155 ; FBMODA( array of modifiers
156 ; where FBMODA(number)=CPT Modifier (internal)
157 ;
158 N FBI,FBIENS,FBFDA
159 S FBIENS=FBM_","_FBL_","_FBK_","_FBJ_","
160 ;
161 ; delete any existing CPT MODIFIER entries from global
162 I $O(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"M",0)) D
163 . K FBFDA S FBI=0
164 . F S FBI=$O(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"M",FBI)) Q:'FBI D
165 . . S FBFDA(162.06,FBI_","_FBIENS,.01)="@"
166 . D FILE^DIE("","FBFDA") D MSG^DIALOG()
167 ;
168 ; create CPT MODIFIER entries from data in array FBMODA
169 I $O(FBMODA(0)) D
170 . K FBFDA S FBI=0 F S FBI=$O(FBMODA(FBI)) Q:'FBI D
171 . . S FBFDA(162.06,"+"_FBI_","_FBIENS,.01)=FBMODA(FBI)
172 . D UPDATE^DIE("","FBFDA") D MSG^DIALOG()
173 ;
174 Q
175 ;
176 ;FBAAUTL4
Note: See TracBrowser for help on using the repository browser.