- 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 Jan 18, 2025@03:13:03 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 ;