IBCEP8A ;ALB/ESG - Functions for provider ID maint ;12/27/2005
;;2.0;INTEGRATED BILLING;**320,349,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
CLIA(IBIFN) ; Default CLIA# for claim
NEW CLIA,NONVA,DIV,INST
S CLIA="",IBIFN=+$G(IBIFN)
S NONVA=+$P($G(^DGCR(399,IBIFN,"U2")),U,10) ; non-VA facility ptr
I NONVA S CLIA=$$CLIANVA^IBCEP8(IBIFN) G CLIAX
;
; retrieve the default VA clia# based on claim data
S DIV=+$P($G(^DGCR(399,IBIFN,0)),U,22) ; claim's division
I 'DIV G CLIAX
S INST=+$P($G(^DG(40.8,DIV,0)),U,7) ; inst file pointer
I 'INST G CLIAX
S CLIA=$$ID^XUAF4("CLIA",INST) ; API for clia#
CLIAX ;
Q CLIA
;
LAB(IBIFN) ; Function determines if LAB type of service is on claim
; Claim must be a CMS-1500 claim form type
N LAB,LN,IBXDATA
S LAB=0
;JWS;IB*2.0*592;Dental form #7 J430D
I $$FT^IBCEF(IBIFN)'=2,$$FT^IBCEF(IBIFN)'=7 G LABX ;cms-1500 and Dental J430D form types only
D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
S LN=0
F S LN=$O(IBXDATA(LN)) Q:'LN I $P(IBXDATA(LN),U,4)=5 S LAB=1 Q
LABX ;
Q LAB
;
CLIAREQ(IBIFN) ; Function determines if the CLIA# is required for claim
; Return value=1 Yes, the CLIA# is required; otherwise 0.
N REQ S REQ=0
;JWS;IB*2.0*592;Dental form #7 J430D
I $$FT^IBCEF(IBIFN)'=2,$$FT^IBCEF(IBIFN)'=7 G CLIAREQX ; cms-1500 and Dental J430D
I '$$LAB(IBIFN) G CLIAREQX ; lab type of service
;
; this is required for VA facility
I '$P($G(^DGCR(399,IBIFN,"U2")),U,10) S REQ=1 G CLIAREQX
;
; for non-VA facility, further check non-VA care type
; Codes 1 and 3 are specifically Non-Lab
I '$F(".1.3.","."_$P($G(^DGCR(399,IBIFN,"U2")),U,11)_".") S REQ=1
CLIAREQX ;
Q REQ
;
MAMMO(IBIFN,IBMC) ; Function to determine the default mammography certification
; number for the claim
; Array IBMC is returned if passed by reference
; IBMC = # of associated mammo#'s
; IBMC(n) = [1] coding system or "" for Non-VA Facilities
; [2] mammo cert#
NEW MAMMO,NONVA,INST,CODSYS,IBMCID,CDSYS
S MAMMO="",IBIFN=+$G(IBIFN),IBMC=0
S NONVA=+$P($G(^DGCR(399,IBIFN,"U2")),U,10) ; non-VA facility ptr
I NONVA D G MAMMOX
. S MAMMO=$P($G(^IBA(355.93,NONVA,0)),U,15) Q:MAMMO=""
. S IBMC=1,IBMC(1)=""_U_MAMMO
. Q
;
; retrieve the default VA mammo# based on claim data
S INST=+$$SITE^VASITE() ; inst file pointer
I 'INST G MAMMOX
;
; Kernel API from XU*8*394 to get a list of coding systems
D LCDSYS^XUAF4(.CDSYS)
S CODSYS="MAMMO"
F S CODSYS=$O(CDSYS(CODSYS)) Q:$E(CODSYS,1,5)'="MAMMO" D
. S IBMCID=$$ID^XUAF4(CODSYS,INST) Q:IBMCID=""
. S IBMC=IBMC+1
. S IBMC(IBMC)=$P(CODSYS,"-",2)_U_IBMCID
. I $P(CODSYS,"-",2)="FDA" S MAMMO=IBMCID ; FDA is default ID#
. Q
I IBMC,MAMMO="" S MAMMO=$P(IBMC(1),U,2)
MAMMOX ;
Q MAMMO
;
MAMMODP(IBIFN) ; Procedure to display a listing of default mammo cert#'s
; Used during input template on screen 8 for CMS-1500 claims
NEW IBMC,IBZ
I $$MAMMO(IBIFN,.IBMC)
I 'IBMC W !!?3,"No default mammography certification numbers on file.",! G MAMMODPX
W !!?3,"The Mammography Certification #" W:IBMC>1 "'s"
W " defined for this " W:$P($G(^DGCR(399,IBIFN,"U2")),U,10) "non-"
W "VA facility " W:IBMC>1 "are:" W:IBMC'>1 "is:"
S IBZ=0
F S IBZ=$O(IBMC(IBZ)) Q:'IBZ W !?7,$P(IBMC(IBZ),U,2),?21,$P(IBMC(IBZ),U,1)
W !?3,"If you enter a different number it will be sent with this claim only."
I $P($G(^DGCR(399,IBIFN,"U2")),U,10) W !?3,"To change the defined Mammography Certification #, use Prov ID Maint."
W !
MAMMODPX ;
Q
;
XRAY(IBIFN) ; Function determines if X-RAY type of service is on claim
; Claim must be a CMS-1500 claim form type
NEW XRAY,LN,IBXDATA
S XRAY=0
;JWS;IB*2.0*592;Dental form #7 J430D
I $$FT^IBCEF(IBIFN)'=2,$$FT^IBCEF(IBIFN)'=7 G XRAYX ;cms-1500 and Dental J430D form types only
D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
S LN=0
F S LN=$O(IBXDATA(LN)) Q:'LN I $P(IBXDATA(LN),U,4)=4 S XRAY=1 Q
XRAYX ;
Q XRAY
;
EIN(IBIFN) ; Function to return the EIN/tax ID for either the VA facility
; or the non-VA facility. Used for SUB-9.
NEW ID,IBU2,NONVA
S ID="",IBU2=$G(^DGCR(399,IBIFN,"U2"))
S NONVA=+$P(IBU2,U,10) ; non-VA facility ptr
I NONVA D G EINX
. S ID=$P($G(^IBA(355.93,NONVA,0)),U,9) ; ID# from file 355.93
. ;
. ; if not defined in file 355.93, then use legacy field# 234 in file
. ; 399 - non-va care id#. See NONVAID^IBCEF72.
. I ID="",$P(IBU2,U,12)'="" S ID=$P(IBU2,U,12)
. Q
;
; VA facility
S ID=$P($G(^IBE(350.9,1,1)),U,5) ; Federal tax id from site params
EINX ;
Q ID
;
BOX324(IBIFN,IBXSAVE,IBXDATA) ; Procedure which further defines and formats
; form 1500, box 32, line 4.
; *** THIS IS NOT USED FOR THE NEW CMS-1500 CLAIM FORM ***
; This is either the facility Tax ID or it is the mammography
; certification number.
; Input: IBIFN, IBXSAVE array (pass by ref), IBXDATA (pass by ref)
; Output: IBXDATA (pass by ref)
;
NEW IBZ
;
; retrieve the mammo# if it exists into variable IBZ
D F^IBCEF("N-MAMMOGRAPHY CERT#","IBZ",,IBIFN)
;
; If the claim is for the main VAMC and there is no mammo# then print
; nothing here. See 364.7 iens# 348, 319, 327 for similar
I '$G(IBXSAVE("REMOTE")),IBZ="" KILL IBXDATA G BOX32X
;
; If the mammo# exists, then display that
I IBZ'="" S IBXDATA="Mammography Cert# "_IBZ G BOX32X
;
; Otherwise, display the facility tax id
S IBXDATA="FAC. ID:"_$G(IBXDATA)
BOX32X ;
KILL IBXSAVE("OFAC"),IBXSAVE("REMOTE") ; cleanup
Q
;
SUB1OK(IBIFN) ; This function determines if the claim meets the criteria
; for being eligible to output a SUB1 segment which is for professional
; purchased services. Must be CMS-1500, non-VA facility, and Fee Basis.
;
NEW OK,IBU2
S OK=0,IBU2=$G(^DGCR(399,IBIFN,"U2"))
;
;JWS;IB*2.0*592;Dental form #7 J430D
I $$FT^IBCEF(IBIFN)'=2,$$FT^IBCEF(IBIFN)'=7 G SX ; must be cms-1500 or Dental J430D
I '$P(IBU2,U,10) G SX ; must be non-VA fac
I '$F(".1.2.","."_$P(IBU2,U,11)_".") G SX ; must be FEE services
;
S OK=1 ; all checks passed, OK for SUB1 output
SX ;
Q OK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP8A 6307 printed Apr 09, 2024@21:17:34 Page 2
IBCEP8A ;ALB/ESG - Functions for provider ID maint ;12/27/2005
+1 ;;2.0;INTEGRATED BILLING;**320,349,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
CLIA(IBIFN) ; Default CLIA# for claim
+1 NEW CLIA,NONVA,DIV,INST
+2 SET CLIA=""
SET IBIFN=+$GET(IBIFN)
+3 ; non-VA facility ptr
SET NONVA=+$PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
+4 IF NONVA
SET CLIA=$$CLIANVA^IBCEP8(IBIFN)
GOTO CLIAX
+5 ;
+6 ; retrieve the default VA clia# based on claim data
+7 ; claim's division
SET DIV=+$PIECE($GET(^DGCR(399,IBIFN,0)),U,22)
+8 IF 'DIV
GOTO CLIAX
+9 ; inst file pointer
SET INST=+$PIECE($GET(^DG(40.8,DIV,0)),U,7)
+10 IF 'INST
GOTO CLIAX
+11 ; API for clia#
SET CLIA=$$ID^XUAF4("CLIA",INST)
CLIAX ;
+1 QUIT CLIA
+2 ;
LAB(IBIFN) ; Function determines if LAB type of service is on claim
+1 ; Claim must be a CMS-1500 claim form type
+2 NEW LAB,LN,IBXDATA
+3 SET LAB=0
+4 ;JWS;IB*2.0*592;Dental form #7 J430D
+5 ;cms-1500 and Dental J430D form types only
IF $$FT^IBCEF(IBIFN)'=2
IF $$FT^IBCEF(IBIFN)'=7
GOTO LABX
+6 DO F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
+7 SET LN=0
+8 FOR
SET LN=$ORDER(IBXDATA(LN))
if 'LN
QUIT
IF $PIECE(IBXDATA(LN),U,4)=5
SET LAB=1
QUIT
LABX ;
+1 QUIT LAB
+2 ;
CLIAREQ(IBIFN) ; Function determines if the CLIA# is required for claim
+1 ; Return value=1 Yes, the CLIA# is required; otherwise 0.
+2 NEW REQ
SET REQ=0
+3 ;JWS;IB*2.0*592;Dental form #7 J430D
+4 ; cms-1500 and Dental J430D
IF $$FT^IBCEF(IBIFN)'=2
IF $$FT^IBCEF(IBIFN)'=7
GOTO CLIAREQX
+5 ; lab type of service
IF '$$LAB(IBIFN)
GOTO CLIAREQX
+6 ;
+7 ; this is required for VA facility
+8 IF '$PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
SET REQ=1
GOTO CLIAREQX
+9 ;
+10 ; for non-VA facility, further check non-VA care type
+11 ; Codes 1 and 3 are specifically Non-Lab
+12 IF '$FIND(".1.3.","."_$PIECE($GET(^DGCR(399,IBIFN,"U2")),U,11)_".")
SET REQ=1
CLIAREQX ;
+1 QUIT REQ
+2 ;
MAMMO(IBIFN,IBMC) ; Function to determine the default mammography certification
+1 ; number for the claim
+2 ; Array IBMC is returned if passed by reference
+3 ; IBMC = # of associated mammo#'s
+4 ; IBMC(n) = [1] coding system or "" for Non-VA Facilities
+5 ; [2] mammo cert#
+6 NEW MAMMO,NONVA,INST,CODSYS,IBMCID,CDSYS
+7 SET MAMMO=""
SET IBIFN=+$GET(IBIFN)
SET IBMC=0
+8 ; non-VA facility ptr
SET NONVA=+$PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
+9 IF NONVA
Begin DoDot:1
+10 SET MAMMO=$PIECE($GET(^IBA(355.93,NONVA,0)),U,15)
if MAMMO=""
QUIT
+11 SET IBMC=1
SET IBMC(1)=""_U_MAMMO
+12 QUIT
End DoDot:1
GOTO MAMMOX
+13 ;
+14 ; retrieve the default VA mammo# based on claim data
+15 ; inst file pointer
SET INST=+$$SITE^VASITE()
+16 IF 'INST
GOTO MAMMOX
+17 ;
+18 ; Kernel API from XU*8*394 to get a list of coding systems
+19 DO LCDSYS^XUAF4(.CDSYS)
+20 SET CODSYS="MAMMO"
+21 FOR
SET CODSYS=$ORDER(CDSYS(CODSYS))
if $EXTRACT(CODSYS,1,5)'="MAMMO"
QUIT
Begin DoDot:1
+22 SET IBMCID=$$ID^XUAF4(CODSYS,INST)
if IBMCID=""
QUIT
+23 SET IBMC=IBMC+1
+24 SET IBMC(IBMC)=$PIECE(CODSYS,"-",2)_U_IBMCID
+25 ; FDA is default ID#
IF $PIECE(CODSYS,"-",2)="FDA"
SET MAMMO=IBMCID
+26 QUIT
End DoDot:1
+27 IF IBMC
IF MAMMO=""
SET MAMMO=$PIECE(IBMC(1),U,2)
MAMMOX ;
+1 QUIT MAMMO
+2 ;
MAMMODP(IBIFN) ; Procedure to display a listing of default mammo cert#'s
+1 ; Used during input template on screen 8 for CMS-1500 claims
+2 NEW IBMC,IBZ
+3 IF $$MAMMO(IBIFN,.IBMC)
+4 IF 'IBMC
WRITE !!?3,"No default mammography certification numbers on file.",!
GOTO MAMMODPX
+5 WRITE !!?3,"The Mammography Certification #"
if IBMC>1
WRITE "'s"
+6 WRITE " defined for this "
if $PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
WRITE "non-"
+7 WRITE "VA facility "
if IBMC>1
WRITE "are:"
if IBMC'>1
WRITE "is:"
+8 SET IBZ=0
+9 FOR
SET IBZ=$ORDER(IBMC(IBZ))
if 'IBZ
QUIT
WRITE !?7,$PIECE(IBMC(IBZ),U,2),?21,$PIECE(IBMC(IBZ),U,1)
+10 WRITE !?3,"If you enter a different number it will be sent with this claim only."
+11 IF $PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
WRITE !?3,"To change the defined Mammography Certification #, use Prov ID Maint."
+12 WRITE !
MAMMODPX ;
+1 QUIT
+2 ;
XRAY(IBIFN) ; Function determines if X-RAY type of service is on claim
+1 ; Claim must be a CMS-1500 claim form type
+2 NEW XRAY,LN,IBXDATA
+3 SET XRAY=0
+4 ;JWS;IB*2.0*592;Dental form #7 J430D
+5 ;cms-1500 and Dental J430D form types only
IF $$FT^IBCEF(IBIFN)'=2
IF $$FT^IBCEF(IBIFN)'=7
GOTO XRAYX
+6 DO F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
+7 SET LN=0
+8 FOR
SET LN=$ORDER(IBXDATA(LN))
if 'LN
QUIT
IF $PIECE(IBXDATA(LN),U,4)=4
SET XRAY=1
QUIT
XRAYX ;
+1 QUIT XRAY
+2 ;
EIN(IBIFN) ; Function to return the EIN/tax ID for either the VA facility
+1 ; or the non-VA facility. Used for SUB-9.
+2 NEW ID,IBU2,NONVA
+3 SET ID=""
SET IBU2=$GET(^DGCR(399,IBIFN,"U2"))
+4 ; non-VA facility ptr
SET NONVA=+$PIECE(IBU2,U,10)
+5 IF NONVA
Begin DoDot:1
+6 ; ID# from file 355.93
SET ID=$PIECE($GET(^IBA(355.93,NONVA,0)),U,9)
+7 ;
+8 ; if not defined in file 355.93, then use legacy field# 234 in file
+9 ; 399 - non-va care id#. See NONVAID^IBCEF72.
+10 IF ID=""
IF $PIECE(IBU2,U,12)'=""
SET ID=$PIECE(IBU2,U,12)
+11 QUIT
End DoDot:1
GOTO EINX
+12 ;
+13 ; VA facility
+14 ; Federal tax id from site params
SET ID=$PIECE($GET(^IBE(350.9,1,1)),U,5)
EINX ;
+1 QUIT ID
+2 ;
BOX324(IBIFN,IBXSAVE,IBXDATA) ; Procedure which further defines and formats
+1 ; form 1500, box 32, line 4.
+2 ; *** THIS IS NOT USED FOR THE NEW CMS-1500 CLAIM FORM ***
+3 ; This is either the facility Tax ID or it is the mammography
+4 ; certification number.
+5 ; Input: IBIFN, IBXSAVE array (pass by ref), IBXDATA (pass by ref)
+6 ; Output: IBXDATA (pass by ref)
+7 ;
+8 NEW IBZ
+9 ;
+10 ; retrieve the mammo# if it exists into variable IBZ
+11 DO F^IBCEF("N-MAMMOGRAPHY CERT#","IBZ",,IBIFN)
+12 ;
+13 ; If the claim is for the main VAMC and there is no mammo# then print
+14 ; nothing here. See 364.7 iens# 348, 319, 327 for similar
+15 IF '$GET(IBXSAVE("REMOTE"))
IF IBZ=""
KILL IBXDATA
GOTO BOX32X
+16 ;
+17 ; If the mammo# exists, then display that
+18 IF IBZ'=""
SET IBXDATA="Mammography Cert# "_IBZ
GOTO BOX32X
+19 ;
+20 ; Otherwise, display the facility tax id
+21 SET IBXDATA="FAC. ID:"_$GET(IBXDATA)
BOX32X ;
+1 ; cleanup
KILL IBXSAVE("OFAC"),IBXSAVE("REMOTE")
+2 QUIT
+3 ;
SUB1OK(IBIFN) ; This function determines if the claim meets the criteria
+1 ; for being eligible to output a SUB1 segment which is for professional
+2 ; purchased services. Must be CMS-1500, non-VA facility, and Fee Basis.
+3 ;
+4 NEW OK,IBU2
+5 SET OK=0
SET IBU2=$GET(^DGCR(399,IBIFN,"U2"))
+6 ;
+7 ;JWS;IB*2.0*592;Dental form #7 J430D
+8 ; must be cms-1500 or Dental J430D
IF $$FT^IBCEF(IBIFN)'=2
IF $$FT^IBCEF(IBIFN)'=7
GOTO SX
+9 ; must be non-VA fac
IF '$PIECE(IBU2,U,10)
GOTO SX
+10 ; must be FEE services
IF '$FIND(".1.2.","."_$PIECE(IBU2,U,11)_".")
GOTO SX
+11 ;
+12 ; all checks passed, OK for SUB1 output
SET OK=1
SX ;
+1 QUIT OK
+2 ;
