- IBCBB1 ;ALB/AAS - CONTINUATION OF EDIT CHECK ROUTINE ; 2-NOV-89
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;MAP TO DGCRBB1
- ;
- % ;Bill Status
- I IBST=""!($L(IBST)>1)!("012347"'[IBST) S IBER=IBER_"IB045;"
- I IBST=0 S IBER="IB045;"
- ;
- ;Statement Covers From
- I IBFDT="" S IBER=IBER_"IB061;"
- I IBFDT]"",IBFDT'?7N&(IBFDT'?7N1".".N) S IBER=IBER_"IB061;"
- S IBFFY=$S($E(IBFDT,4,5)<10:$E(IBFDT,2,3),1:$E(IBFDT,2,3)+1)
- ;
- ;Statement Covers To
- I IBTDT="" S IBER=IBER_"IB062;"
- I IBTDT]"",IBTDT'?7N&(IBTDT'?7N1".".N) S IBER=IBER_"IB062;"
- S IBTFY=$S($E(IBTDT,4,5)<10:$E(IBTDT,2,3),1:$E(IBTDT,2,3)+1)
- ;
- ;Statement crosses fiscal years
- I IBTFY'=IBFFY S IBER=IBER_"IB047;"
- ;
- ;Statement crosses calendar years
- I $E(IBTDT,1,3)'=$E(IBFDT,1,3) S IBER=IBER_"IB046;"
- ;
- ;Total Charges
- I +IBTC'>0!(+IBTC'=IBTC) S IBER=IBER_"IB064;"
- ;
- ;Fiscal Year 1
- I IBFY=""!($L(IBFY)'=2)!(IBFY<80)!(IBFY>($S($E(DT,4,5)<10:$E(DT,2,3),1:$E(DT,2,3)+1))) S IBER=IBER_"IB050;"
- ;
- ;FY 1 Charges
- I +IBFYC'>0!(+IBFYC'=IBFYC) S IBER=IBER_"IB051;"
- ;
- ;FY 1 Charges minus offset greater than 0
- I +IBFYC-$P(IBNDU1,"^",2)'>0 S IBER=IBER_"IB052;"
- ;
- ;Check provider link for current user, enterer, reviewer and Authorizor
- I '$D(^VA(200,DUZ,0)) S IBER=IBER_"IB048;"
- I IBEU]"",'$D(^VA(200,IBEU,0)) S IBER=IBER_"IB048;"
- I IBRU]"",'$D(^VA(200,IBRU,0)) S IBER=IBER_"IB060;"
- I IBAU]"",'$D(^VA(200,IBAU,0)) S IBER=IBER_"IB041;"
- ;
- ;Bill exists and not already new bill
- ;I $S('$D(^PRCA(430,IBIFN,0)):1,$P($P(^PRCA(430,IBIFN,0),"^"),"-",2)'=IBBNO:1,1:0) S IBER=IBER_"IB056;"
- ;I $P($$BN^PRCAFN(IBIFN),"-",2)'=IBBNO S IBER=IBER_"IB056;"
- ;I IBER="",$P(^PRCA(430,IBIFN,0),"^",8)=$O(^PRCA(430.3,"AC",104,"")) S IBER=IBER_"IB040;"
- I IBER="",+$$STA^PRCAFN(IBIFN)=104 S IBER=IBER_"IB040;"
- ;
- ;asc on bill and more than one visit, ub's only
- I IBFT'=2,IBWHO="i",$D(^DGCR(399,"ASC2",IBIFN)),$O(^($O(^DGCR(399,IBIFN,"OP",0)))) S IBER=IBER_"IB042;"
- ;
- ;edit checks for HCFA 1500 forms
- I IBFT=2 D ^IBCBB2
- ;
- ;Other things that could be added: Revenue Code - calculating charges
- ; Diagnosis Coding, if Cat C - check for other co-payments
- ;
- D ARRAY:IBER=""
- ;
- END ;Don't kill IBifn, IBer, dfn
- K IBBNO,IBEVDT,IBLOC,IBCL,IBTF,IBAT,IBWHO,IBST,IBFDT,IBTDT,IBTC,IBFY,IBFY1,IBAU,IBRU,IBEU,IBARTP,IBFYC,IBNDS,IBND0,IBNDU,IBNDM,IBNDU1,IBFFY,IBTFY,IBFT
- I $D(IBER),IBER="" W !,"No Errors found"
- Q
- ;
- ARRAY ;Build PRCASV(array)
- K PRCASV
- S X=IBIFN D ^IBCAMS S:Y>0 PRCASV("AMIS")=Y
- S PRCASV("BDT")=DT,PRCASV("ARREC")=IBIFN
- S PRCASV("APR")=DUZ
- S PRCASV("PAT")=DFN,PRCASV("CAT")=$P(^DGCR(399.3,IBAT,0),"^",6)
- I IBWHO="i" S PRCASV("DEBTOR")=+IBNDM_";DIC(36,"
- S PRCASV("DEBTOR")=$S(IBWHO="p":DFN_";DPT(",IBWHO="o":$P(IBNDM,"^",11)_";DIC(4,",IBWHO="i":PRCASV("DEBTOR"),1:"")
- S PRCASV("CARE")=IBLOC_IBCL
- S PRCASV("FY")=$P(IBNDU1,U,9)_U_$S($P(IBNDU1,U,2)]"":($P(IBNDU1,U,10)-$P(IBNDU1,U,2)),1:$P(IBNDU1,U,10))_$S($P(IBNDU1,U,11)]"":U_$P(IBNDU1,U,11)_U_$P(IBNDU1,U,12),1:"")
- PLUS I IBWHO="i",$P(IBNDM,"^",2),$D(^DIC(36,$P(IBNDM,"^",2),0)) S PRCASV("2NDINS")=$P(IBNDM,"^",2)
- I IBWHO="i",$P(IBNDM,"^",3),$D(^DIC(36,$P(IBNDM,"^",3),0)) S PRCASV("3RDINS")=$P(IBNDM,"^",3)
- Q:'$D(^DGCR(399,IBIFN,"I1")) S IBNDI1=^("I1")
- S:$P(IBNDI1,"^",3)]"" PRCASV("GPNO")=$P(IBNDI1,"^",3)
- S:$P(IBNDI1,"^",15)]"" PRCASV("GPNM")=$P(IBNDI1,"^",15)
- S:$P(IBNDI1,"^",17)]"" PRCASV("INPA")=$P(IBNDI1,"^",17)
- S:$P(IBNDI1,"^",2)]"" PRCASV("IDNO")=$P(IBNDI1,"^",2),PRCASV("INID")=PRCASV("IDNO")
- Q
- IBCBB1 ;ALB/AAS - CONTINUATION OF EDIT CHECK ROUTINE ; 2-NOV-89
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRBB1
- +5 ;
- % ;Bill Status
- +1 IF IBST=""!($LENGTH(IBST)>1)!("012347"'[IBST)
- SET IBER=IBER_"IB045;"
- +2 IF IBST=0
- SET IBER="IB045;"
- +3 ;
- +4 ;Statement Covers From
- +5 IF IBFDT=""
- SET IBER=IBER_"IB061;"
- +6 IF IBFDT]""
- IF IBFDT'?7N&(IBFDT'?7N1".".N)
- SET IBER=IBER_"IB061;"
- +7 SET IBFFY=$SELECT($EXTRACT(IBFDT,4,5)<10:$EXTRACT(IBFDT,2,3),1:$EXTRACT(IBFDT,2,3)+1)
- +8 ;
- +9 ;Statement Covers To
- +10 IF IBTDT=""
- SET IBER=IBER_"IB062;"
- +11 IF IBTDT]""
- IF IBTDT'?7N&(IBTDT'?7N1".".N)
- SET IBER=IBER_"IB062;"
- +12 SET IBTFY=$SELECT($EXTRACT(IBTDT,4,5)<10:$EXTRACT(IBTDT,2,3),1:$EXTRACT(IBTDT,2,3)+1)
- +13 ;
- +14 ;Statement crosses fiscal years
- +15 IF IBTFY'=IBFFY
- SET IBER=IBER_"IB047;"
- +16 ;
- +17 ;Statement crosses calendar years
- +18 IF $EXTRACT(IBTDT,1,3)'=$EXTRACT(IBFDT,1,3)
- SET IBER=IBER_"IB046;"
- +19 ;
- +20 ;Total Charges
- +21 IF +IBTC'>0!(+IBTC'=IBTC)
- SET IBER=IBER_"IB064;"
- +22 ;
- +23 ;Fiscal Year 1
- +24 IF IBFY=""!($LENGTH(IBFY)'=2)!(IBFY<80)!(IBFY>($SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,2,3),1:$EXTRACT(DT,2,3)+1)))
- SET IBER=IBER_"IB050;"
- +25 ;
- +26 ;FY 1 Charges
- +27 IF +IBFYC'>0!(+IBFYC'=IBFYC)
- SET IBER=IBER_"IB051;"
- +28 ;
- +29 ;FY 1 Charges minus offset greater than 0
- +30 IF +IBFYC-$PIECE(IBNDU1,"^",2)'>0
- SET IBER=IBER_"IB052;"
- +31 ;
- +32 ;Check provider link for current user, enterer, reviewer and Authorizor
- +33 IF '$DATA(^VA(200,DUZ,0))
- SET IBER=IBER_"IB048;"
- +34 IF IBEU]""
- IF '$DATA(^VA(200,IBEU,0))
- SET IBER=IBER_"IB048;"
- +35 IF IBRU]""
- IF '$DATA(^VA(200,IBRU,0))
- SET IBER=IBER_"IB060;"
- +36 IF IBAU]""
- IF '$DATA(^VA(200,IBAU,0))
- SET IBER=IBER_"IB041;"
- +37 ;
- +38 ;Bill exists and not already new bill
- +39 ;I $S('$D(^PRCA(430,IBIFN,0)):1,$P($P(^PRCA(430,IBIFN,0),"^"),"-",2)'=IBBNO:1,1:0) S IBER=IBER_"IB056;"
- +40 ;I $P($$BN^PRCAFN(IBIFN),"-",2)'=IBBNO S IBER=IBER_"IB056;"
- +41 ;I IBER="",$P(^PRCA(430,IBIFN,0),"^",8)=$O(^PRCA(430.3,"AC",104,"")) S IBER=IBER_"IB040;"
- +42 IF IBER=""
- IF +$$STA^PRCAFN(IBIFN)=104
- SET IBER=IBER_"IB040;"
- +43 ;
- +44 ;asc on bill and more than one visit, ub's only
- +45 IF IBFT'=2
- IF IBWHO="i"
- IF $DATA(^DGCR(399,"ASC2",IBIFN))
- IF $ORDER(^($ORDER(^DGCR(399,IBIFN,"OP",0))))
- SET IBER=IBER_"IB042;"
- +46 ;
- +47 ;edit checks for HCFA 1500 forms
- +48 IF IBFT=2
- DO ^IBCBB2
- +49 ;
- +50 ;Other things that could be added: Revenue Code - calculating charges
- +51 ; Diagnosis Coding, if Cat C - check for other co-payments
- +52 ;
- +53 IF IBER=""
- DO ARRAY
- +54 ;
- END ;Don't kill IBifn, IBer, dfn
- +1 KILL IBBNO,IBEVDT,IBLOC,IBCL,IBTF,IBAT,IBWHO,IBST,IBFDT,IBTDT,IBTC,IBFY,IBFY1,IBAU,IBRU,IBEU,IBARTP,IBFYC,IBNDS,IBND0,IBNDU,IBNDM,IBNDU1,IBFFY,IBTFY,IBFT
- +2 IF $DATA(IBER)
- IF IBER=""
- WRITE !,"No Errors found"
- +3 QUIT
- +4 ;
- ARRAY ;Build PRCASV(array)
- +1 KILL PRCASV
- +2 SET X=IBIFN
- DO ^IBCAMS
- IF Y>0
- SET PRCASV("AMIS")=Y
- +3 SET PRCASV("BDT")=DT
- SET PRCASV("ARREC")=IBIFN
- +4 SET PRCASV("APR")=DUZ
- +5 SET PRCASV("PAT")=DFN
- SET PRCASV("CAT")=$PIECE(^DGCR(399.3,IBAT,0),"^",6)
- +6 IF IBWHO="i"
- SET PRCASV("DEBTOR")=+IBNDM_";DIC(36,"
- +7 SET PRCASV("DEBTOR")=$SELECT(IBWHO="p":DFN_";DPT(",IBWHO="o":$PIECE(IBNDM,"^",11)_";DIC(4,",IBWHO="i":PRCASV("DEBTOR"),1:"")
- +8 SET PRCASV("CARE")=IBLOC_IBCL
- +9 SET PRCASV("FY")=$PIECE(IBNDU1,U,9)_U_$SELECT($PIECE(IBNDU1,U,2)]"":($PIECE(IBNDU1,U,10)-$PIECE(IBNDU1,U,2)),1:$PIECE(IBNDU1,U,10))_$SELECT($PIECE(IBNDU1,U,11)]"":U_$PIECE(IBNDU1,U,11)_U_$PIECE(IBNDU1,U,12),1:"")
- PLUS IF IBWHO="i"
- IF $PIECE(IBNDM,"^",2)
- IF $DATA(^DIC(36,$PIECE(IBNDM,"^",2),0))
- SET PRCASV("2NDINS")=$PIECE(IBNDM,"^",2)
- +1 IF IBWHO="i"
- IF $PIECE(IBNDM,"^",3)
- IF $DATA(^DIC(36,$PIECE(IBNDM,"^",3),0))
- SET PRCASV("3RDINS")=$PIECE(IBNDM,"^",3)
- +2 IF '$DATA(^DGCR(399,IBIFN,"I1"))
- QUIT
- SET IBNDI1=^("I1")
- +3 IF $PIECE(IBNDI1,"^",3)]""
- SET PRCASV("GPNO")=$PIECE(IBNDI1,"^",3)
- +4 IF $PIECE(IBNDI1,"^",15)]""
- SET PRCASV("GPNM")=$PIECE(IBNDI1,"^",15)
- +5 IF $PIECE(IBNDI1,"^",17)]""
- SET PRCASV("INPA")=$PIECE(IBNDI1,"^",17)
- +6 IF $PIECE(IBNDI1,"^",2)]""
- SET PRCASV("IDNO")=$PIECE(IBNDI1,"^",2)
- SET PRCASV("INID")=PRCASV("IDNO")
- +7 QUIT
