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

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1IBCEP8A ;ALB/ESG - Functions for provider ID maint ;12/27/2005
2 ;;2.0;INTEGRATED BILLING;**320,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7CLIA(IBIFN) ; Default CLIA# for claim
8 NEW CLIA,NONVA,DIV,INST
9 S CLIA="",IBIFN=+$G(IBIFN)
10 S NONVA=+$P($G(^DGCR(399,IBIFN,"U2")),U,10) ; non-VA facility ptr
11 I NONVA S CLIA=$$CLIANVA^IBCEP8(IBIFN) G CLIAX
12 ;
13 ; retrieve the default VA clia# based on claim data
14 S DIV=+$P($G(^DGCR(399,IBIFN,0)),U,22) ; claim's division
15 I 'DIV G CLIAX
16 S INST=+$P($G(^DG(40.8,DIV,0)),U,7) ; inst file pointer
17 I 'INST G CLIAX
18 S CLIA=$$ID^XUAF4("CLIA",INST) ; API for clia#
19CLIAX ;
20 Q CLIA
21 ;
22LAB(IBIFN) ; Function determines if LAB type of service is on claim
23 ; Claim must be a CMS-1500 claim form type
24 NEW LAB,LN,IBXDATA
25 S LAB=0
26 I $$FT^IBCEF(IBIFN)'=2 G LABX ;cms-1500 form types only
27 D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
28 S LN=0
29 F S LN=$O(IBXDATA(LN)) Q:'LN I $P(IBXDATA(LN),U,4)=5 S LAB=1 Q
30LABX ;
31 Q LAB
32 ;
33CLIAREQ(IBIFN) ; Function determines if the CLIA# is required for claim
34 ; Return value=1 Yes, the CLIA# is required; otherwise 0.
35 NEW REQ S REQ=0
36 I $$FT^IBCEF(IBIFN)'=2 G CLIAREQX ; cms-1500 claim
37 I '$$LAB(IBIFN) G CLIAREQX ; lab type of service
38 ;
39 ; this is required for VA facility
40 I '$P($G(^DGCR(399,IBIFN,"U2")),U,10) S REQ=1 G CLIAREQX
41 ;
42 ; for non-VA facility, further check non-VA care type
43 ; Codes 1 and 3 are specifically Non-Lab
44 I '$F(".1.3.","."_$P($G(^DGCR(399,IBIFN,"U2")),U,11)_".") S REQ=1
45CLIAREQX ;
46 Q REQ
47 ;
48MAMMO(IBIFN,IBMC) ; Function to determine the default mammography certification
49 ; number for the claim
50 ; Array IBMC is returned if passed by reference
51 ; IBMC = # of associated mammo#'s
52 ; IBMC(n) = [1] coding system or "" for Non-VA Facilities
53 ; [2] mammo cert#
54 NEW MAMMO,NONVA,INST,CODSYS,IBMCID,CDSYS
55 S MAMMO="",IBIFN=+$G(IBIFN),IBMC=0
56 S NONVA=+$P($G(^DGCR(399,IBIFN,"U2")),U,10) ; non-VA facility ptr
57 I NONVA D G MAMMOX
58 . S MAMMO=$P($G(^IBA(355.93,NONVA,0)),U,15) Q:MAMMO=""
59 . S IBMC=1,IBMC(1)=""_U_MAMMO
60 . Q
61 ;
62 ; retrieve the default VA mammo# based on claim data
63 S INST=+$$SITE^VASITE() ; inst file pointer
64 I 'INST G MAMMOX
65 ;
66 ; Kernel API from XU*8*394 to get a list of coding systems
67 D LCDSYS^XUAF4(.CDSYS)
68 S CODSYS="MAMMO"
69 F S CODSYS=$O(CDSYS(CODSYS)) Q:$E(CODSYS,1,5)'="MAMMO" D
70 . S IBMCID=$$ID^XUAF4(CODSYS,INST) Q:IBMCID=""
71 . S IBMC=IBMC+1
72 . S IBMC(IBMC)=$P(CODSYS,"-",2)_U_IBMCID
73 . I $P(CODSYS,"-",2)="FDA" S MAMMO=IBMCID ; FDA is default ID#
74 . Q
75 I IBMC,MAMMO="" S MAMMO=$P(IBMC(1),U,2)
76MAMMOX ;
77 Q MAMMO
78 ;
79MAMMODP(IBIFN) ; Procedure to display a listing of default mammo cert#'s
80 ; Used during input template on screen 8 for CMS-1500 claims
81 NEW IBMC,IBZ
82 I $$MAMMO(IBIFN,.IBMC)
83 I 'IBMC W !!?3,"No default mammography certification numbers on file.",! G MAMMODPX
84 W !!?3,"The Mammography Certification #" W:IBMC>1 "'s"
85 W " defined for this " W:$P($G(^DGCR(399,IBIFN,"U2")),U,10) "non-"
86 W "VA facility " W:IBMC>1 "are:" W:IBMC'>1 "is:"
87 S IBZ=0
88 F S IBZ=$O(IBMC(IBZ)) Q:'IBZ W !?7,$P(IBMC(IBZ),U,2),?21,$P(IBMC(IBZ),U,1)
89 W !?3,"If you enter a different number it will be sent with this claim only."
90 I $P($G(^DGCR(399,IBIFN,"U2")),U,10) W !?3,"To change the defined Mammography Certification #, use Prov ID Maint."
91 W !
92MAMMODPX ;
93 Q
94 ;
95XRAY(IBIFN) ; Function determines if X-RAY type of service is on claim
96 ; Claim must be a CMS-1500 claim form type
97 NEW XRAY,LN,IBXDATA
98 S XRAY=0
99 I $$FT^IBCEF(IBIFN)'=2 G XRAYX ;cms-1500 form types only
100 D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
101 S LN=0
102 F S LN=$O(IBXDATA(LN)) Q:'LN I $P(IBXDATA(LN),U,4)=4 S XRAY=1 Q
103XRAYX ;
104 Q XRAY
105 ;
106EIN(IBIFN) ; Function to return the EIN/tax ID for either the VA facility
107 ; or the non-VA facility. Used for SUB-9.
108 NEW ID,IBU2,NONVA
109 S ID="",IBU2=$G(^DGCR(399,IBIFN,"U2"))
110 S NONVA=+$P(IBU2,U,10) ; non-VA facility ptr
111 I NONVA D G EINX
112 . S ID=$P($G(^IBA(355.93,NONVA,0)),U,9) ; ID# from file 355.93
113 . ;
114 . ; if not defined in file 355.93, then use legacy field# 234 in file
115 . ; 399 - non-va care id#. See NONVAID^IBCEF72.
116 . I ID="",$P(IBU2,U,12)'="" S ID=$P(IBU2,U,12)
117 . Q
118 ;
119 ; VA facility
120 S ID=$P($G(^IBE(350.9,1,1)),U,5) ; Federal tax id from site params
121EINX ;
122 Q ID
123 ;
124BOX324(IBIFN,IBXSAVE,IBXDATA) ; Procedure which further defines and formats
125 ; form 1500, box 32, line 4.
126 ; *** THIS IS NOT USED FOR THE NEW CMS-1500 CLAIM FORM ***
127 ; This is either the facility Tax ID or it is the mammography
128 ; certification number.
129 ; Input: IBIFN, IBXSAVE array (pass by ref), IBXDATA (pass by ref)
130 ; Output: IBXDATA (pass by ref)
131 ;
132 NEW IBZ
133 ;
134 ; retrieve the mammo# if it exists into variable IBZ
135 D F^IBCEF("N-MAMMOGRAPHY CERT#","IBZ",,IBIFN)
136 ;
137 ; If the claim is for the main VAMC and there is no mammo# then print
138 ; nothing here. See 364.7 iens# 348, 319, 327 for similar
139 I '$G(IBXSAVE("REMOTE")),IBZ="" KILL IBXDATA G BOX32X
140 ;
141 ; If the mammo# exists, then display that
142 I IBZ'="" S IBXDATA="Mammography Cert# "_IBZ G BOX32X
143 ;
144 ; Otherwise, display the facility tax id
145 S IBXDATA="FAC. ID:"_$G(IBXDATA)
146BOX32X ;
147 KILL IBXSAVE("OFAC"),IBXSAVE("REMOTE") ; cleanup
148 Q
149 ;
150SUB1OK(IBIFN) ; This function determines if the claim meets the criteria
151 ; for being eligible to output a SUB1 segment which is for professional
152 ; purchased services. Must be CMS-1500, non-VA facility, and Fee Basis.
153 ;
154 NEW OK,IBU2
155 S OK=0,IBU2=$G(^DGCR(399,IBIFN,"U2"))
156 ;
157 I $$FT^IBCEF(IBIFN)'=2 G SX ; must be cms-1500
158 I '$P(IBU2,U,10) G SX ; must be non-VA fac
159 I '$F(".1.2.","."_$P(IBU2,U,11)_".") G SX ; must be FEE services
160 ;
161 S OK=1 ; all checks passed, OK for SUB1 output
162SX ;
163 Q OK
164 ;
Note: See TracBrowser for help on using the repository browser.