Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEP8A

IBCEP8A.m

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