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

IBCSC10.m

Go to the documentation of this file.
  1. IBCSC10 ;ALB/MJB - MCCR SCREEN 10 (UB-82 BILL SPECIFIC INFO) ;27 MAY 88 10:20
  1. ;;2.0;INTEGRATED BILLING;**432,547,574,592,759**;21-MAR-94;Build 24
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRSC8
  1. ;
  1. ; DEM;432 - Moved IBCSC8* billing screen routines to IBCSC10* billing screen
  1. ; routines and created a new billing screen 8 routine IBCSC8.
  1. ;
  1. ;JWS;IB*2.0*592 US1108 - Dental form 7
  1. EN S IBCUBFT=$$FT^IBCU3(IBIFN) I IBCUBFT=2!(IBCUBFT=7) K IBCUBFT G ^IBCSC10H ; hcfa 1500 ;JWS 3/6/17 Dental Form
  1. I IBCUBFT=3 K IBCUBFT G ^IBCSC102 ; ub-92
  1. ;I $P(^DGCR(399,IBIFN,0),"^",19)=2 G ^IBCSC10H ;hcfa 1500
  1. D ^IBCSCU S IBSR=10,IBSR1="",IBV1="000000000" S:IBV IBV1="111111111" F I="U","U1",0 S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
  1. D H^IBCSCU
  1. S Z=1,IBW=1 X IBWW W " Bill Remark : ",$S($P(IB("U1"),U,8)]"":$P(IB("U1"),U,8),1:IBUN)
  1. S IBX="^^^2^9^27^45" F I=4:1:7 S Z=(I-2),IBW=1 X IBWW W " Form Locator ",$P(IBX,U,I),$S($E($P(IBX,U,I),2)="":" : ",1:": "),$S($P(IB("U1"),U,I)]"":$P(IB("U1"),U,I),1:IBUN)
  1. S IBX=91 F I=13,14 S Z=(I-7),IBW=1,IBX=IBX+1 X IBWW W " Form Locator ",IBX,": ",$S($P(IB("U1"),U,I)]"":$P(IB("U1"),U,I),1:IBUN)
  1. S Z=8,IBW=1 X IBWW W " Tx Auth. Code : ",$S($P(IB("U"),U,13)]"":$P(IB("U"),U,13),1:IBUN)
  1. G ^IBCSCP
  1. Q Q
  1. ;
  1. ;WCJ;IB*2.0*547
  1. ACINTEL(IBINSDAT,IBNEXT) ; build some intelligence in this Alternate ID branching logic called from both screen 10 templates.
  1. ;
  1. ; assumes IBIFN = the ien to file 399
  1. ;
  1. ; Input:
  1. ; IBINSDAT - INS DATA node
  1. ; IBNEXT - where to branch if not correct plan
  1. ;
  1. ; Returns - where to branch to
  1. ; kind of misleading. It either changes IBNEXT to null or leaves it alone.
  1. ; Assumes calling routine knew where to branch to if it failed
  1. ;
  1. N IBPLAN,IBEPT,IBINSPRF
  1. S IBPLAN=$P(IBINSDAT,U,18)
  1. I IBPLAN="" Q IBNEXT
  1. S IBPLAN=$G(^IBA(355.3,+IBPLAN,0))
  1. I IBPLAN="" Q IBNEXT
  1. S IBEPT=$P(IBPLAN,U,15)
  1. I IBEPT="" Q IBNEXT
  1. I IBEPT="MX" Q:'$D(^IBE(350.9,1,81,"B")) IBNEXT ; no medicare set up in site parameters
  1. I IBEPT'="MX" Q:'$D(^IBE(350.9,1,82,"B")) IBNEXT ; no commercial set up in site parameters
  1. ;
  1. ; Use form type not charge type 09/07/2016
  1. ;S IBINSPRF=$$INSPRF^IBCEF(IBIFN)
  1. S IBINSPRF=$$FT^IBCEF(+IBIFN)=3 ; set IBINST flag=1 if it is institutional,0 for professional.
  1. ;
  1. ; Institutional
  1. I IBINSPRF=1 Q:'$D(^DIC(36,+IBINSDAT,15,"B")) IBNEXT ; this insurance company has no institutional set up
  1. ;
  1. ; Professional
  1. I IBINSPRF=0 Q:'$D(^DIC(36,+IBINSDAT,16,"B")) IBNEXT ; this insurance company has no professional set up
  1. ;
  1. ; now it gets complicated :)
  1. ; there needs to be one set up for this form type in the ins comp file
  1. ; and also set up for medicare/commercial in the site parameter file
  1. N IBTMPINS,IBTMPSP,IBLOOP,IBFOUND
  1. M IBTMPINS=^DIC(36,+IBINSDAT,$S(IBINSPRF=1:15,1:16),"B")
  1. M IBTMPSP=^IBE(350.9,1,$S(IBEPT="MX":81,1:82),"B")
  1. S IBLOOP="",IBFOUND=0
  1. F S IBLOOP=$O(IBTMPINS(IBLOOP)) Q:IBLOOP="" D Q:IBFOUND
  1. . Q:'$D(IBTMPSP(IBLOOP))
  1. . S IBFOUND=1
  1. I IBFOUND Q ""
  1. Q IBNEXT
  1. ;
  1. ;WCJ;IB759
  1. BBB(IBIFN) ; aka Baby Bird Beaks
  1. ; this is an API to tell if any insurer on the claim has Alternate Payer IDs properly defined.
  1. ; If not, it returns a 0 and the section of the billing screen is uneditable
  1. ; which shows as <#> to the biller
  1. ;
  1. ; Input:
  1. ; IBIFN - Internalk Entry Number to file 399
  1. ;
  1. ; Returns 1 or 0, yay or nay
  1. N IBDATA,IBRESULT,IBLOOP,IBX
  1. S IBRESULT=0
  1. F IBLOOP=1:1:3 S IBDATA=$G(^DGCR(399,IBIFN,"I"_IBLOOP)) I IBDATA]"" S IBX=$$ACINTEL(IBDATA,"@WHATEVER") I IBX'="@WHATEVER" S IBRESULT=1 Q
  1. Q IBRESULT
  1. ;
  1. ;IBCSC10