- IBCBB ;ALB/AAS - EDIT CHECK ROUTINE TO BE INVOKED BEFORE ALL BILL APPROVAL ACTIONS ; 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 DGCRBB
- ;
- ;IBNDn = IBND(n) = ^ib(399,n)
- ;RETURNS:
- ;IBER=fields with errors seperated by semi-colons
- ;PRCASV("OKAY")=1 if iber="" and $D(prcasv("array")) compete
- ;
- GVAR ;set up variablesfor mccr
- Q:'$D(IBIFN) F I=0,"M","U","U1","S" S @("IBND"_I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
- S IBBNO=$P(IBND0,"^"),DFN=$P(IBND0,"^",2),IBEVDT=$P(IBND0,"^",3)
- S IBLOC=$P(IBND0,"^",4),IBCL=$P(IBND0,"^",5),IBTF=$P(IBND0,"^",6)
- S IBAT=$P(IBND0,"^",7),IBWHO=$P(IBND0,"^",11),IBST=$P(IBND0,"^",13),IBFT=$P(IBND0,"^",19)
- S IBFDT=$P(IBNDU,"^",1),IBTDT=$P(IBNDU,"^",2)
- S IBTC=$P(IBNDU1,"^",1),IBFY=$P(IBNDU1,"^",9),IBFYC=$P(IBNDU1,"^",10)
- S IBEU=$P(IBNDS,"^",2),IBRU=$P(IBNDS,"^",5),IBAU=$P(IBNDS,"^",8)
- Q
- ;
- EN ;Entry to check for errors
- S IBER="" D GVAR Q:'$D(IBND0)
- ;
- ;Bill number in correct format
- ;I IBBNO'?6N&(IBBNO'?5N1U) S IBER="IB044;"
- ;
- ;patient in patient file
- I DFN="" S IBER=IBER_"IB057;"
- I DFN]"",'$D(^DPT(DFN)) S IBER=IBER_"IB057;"
- ;
- ;Event date in correct format
- I IBEVDT="" S IBER=IBER_"IB049;"
- I IBEVDT]"",IBEVDT'?7N&(IBEVDT'?7N1".".N) S IBER=IBER_"IB049;"
- ;
- ;location of care
- I IBLOC=""!($L(IBLOC)>1)!("127"'[IBLOC) S IBER=IBER_"IB055;"
- ;
- ;Bill classification
- I IBCL=""!($L(IBCL)>1)!("1234"'[IBCL) S IBER=IBER_"IB043;"
- ;
- ;Timeframe of Bill
- I IBTF=""!($L(IBTF)>1)!("01234567"'[IBTF) S IBER=IBER_"IB063;"
- ;May want to check timeframe versus other bills for this episode (later)
- ;
- ;Rate Type
- I IBAT="" S IBER=IBER_"IB059;"
- I IBAT]"",'$D(^DGCR(399.3,IBAT,0)) S IBER=IBER_"IB059;"
- I IBAT]"",$D(^DGCR(399.3,IBAT,0)),'$P(^(0),"^",6) S IBER=IBER_"IB059;",IBAT=""
- ;I IBAT]"",$D(^DGCR(399.3,IBAT,0)) S IBARTP=$P(^PRCA(430.2,$P(^DGCR(399.3,IBAT,0),"^",6),0),"^",6)
- I IBAT]"",$P($G(^DGCR(399.3,IBAT,0)),"^",6) S IBARTP=$P($$CATN^PRCAFN($P(^DGCR(399.3,IBAT,0),"^",6)),"^",3)
- ;Check that AR catagory expects same debtor as defined in who's respon.
- I $D(IBARTP),IBWHO="i"&(IBARTP'="T")!(IBWHO="p"&("PC"'[IBARTP))!(IBWHO="o"&(IBARTP'="N")) S IBER=IBER_"IB058;"
- ;
- ;Who's Responsible
- I IBWHO=""!($L(IBWHO)>1)!("iop"'[IBWHO) S IBER=IBER_"IB065;"
- I IBWHO="i",'+IBNDM S IBER=IBER_"IB054;"
- I IBWHO="o",'+$P(IBNDM,"^",11) S IBER=IBER_"IB053;"
- ;
- G ^IBCBB1
- IBCBB ;ALB/AAS - EDIT CHECK ROUTINE TO BE INVOKED BEFORE ALL BILL APPROVAL ACTIONS ; 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 DGCRBB
- +5 ;
- +6 ;IBNDn = IBND(n) = ^ib(399,n)
- +7 ;RETURNS:
- +8 ;IBER=fields with errors seperated by semi-colons
- +9 ;PRCASV("OKAY")=1 if iber="" and $D(prcasv("array")) compete
- +10 ;
- GVAR ;set up variablesfor mccr
- +1 IF '$DATA(IBIFN)
- QUIT
- FOR I=0,"M","U","U1","S"
- SET @("IBND"_I)=$SELECT($DATA(^DGCR(399,IBIFN,I)):^(I),1:"")
- +2 SET IBBNO=$PIECE(IBND0,"^")
- SET DFN=$PIECE(IBND0,"^",2)
- SET IBEVDT=$PIECE(IBND0,"^",3)
- +3 SET IBLOC=$PIECE(IBND0,"^",4)
- SET IBCL=$PIECE(IBND0,"^",5)
- SET IBTF=$PIECE(IBND0,"^",6)
- +4 SET IBAT=$PIECE(IBND0,"^",7)
- SET IBWHO=$PIECE(IBND0,"^",11)
- SET IBST=$PIECE(IBND0,"^",13)
- SET IBFT=$PIECE(IBND0,"^",19)
- +5 SET IBFDT=$PIECE(IBNDU,"^",1)
- SET IBTDT=$PIECE(IBNDU,"^",2)
- +6 SET IBTC=$PIECE(IBNDU1,"^",1)
- SET IBFY=$PIECE(IBNDU1,"^",9)
- SET IBFYC=$PIECE(IBNDU1,"^",10)
- +7 SET IBEU=$PIECE(IBNDS,"^",2)
- SET IBRU=$PIECE(IBNDS,"^",5)
- SET IBAU=$PIECE(IBNDS,"^",8)
- +8 QUIT
- +9 ;
- EN ;Entry to check for errors
- +1 SET IBER=""
- DO GVAR
- IF '$DATA(IBND0)
- QUIT
- +2 ;
- +3 ;Bill number in correct format
- +4 ;I IBBNO'?6N&(IBBNO'?5N1U) S IBER="IB044;"
- +5 ;
- +6 ;patient in patient file
- +7 IF DFN=""
- SET IBER=IBER_"IB057;"
- +8 IF DFN]""
- IF '$DATA(^DPT(DFN))
- SET IBER=IBER_"IB057;"
- +9 ;
- +10 ;Event date in correct format
- +11 IF IBEVDT=""
- SET IBER=IBER_"IB049;"
- +12 IF IBEVDT]""
- IF IBEVDT'?7N&(IBEVDT'?7N1".".N)
- SET IBER=IBER_"IB049;"
- +13 ;
- +14 ;location of care
- +15 IF IBLOC=""!($LENGTH(IBLOC)>1)!("127"'[IBLOC)
- SET IBER=IBER_"IB055;"
- +16 ;
- +17 ;Bill classification
- +18 IF IBCL=""!($LENGTH(IBCL)>1)!("1234"'[IBCL)
- SET IBER=IBER_"IB043;"
- +19 ;
- +20 ;Timeframe of Bill
- +21 IF IBTF=""!($LENGTH(IBTF)>1)!("01234567"'[IBTF)
- SET IBER=IBER_"IB063;"
- +22 ;May want to check timeframe versus other bills for this episode (later)
- +23 ;
- +24 ;Rate Type
- +25 IF IBAT=""
- SET IBER=IBER_"IB059;"
- +26 IF IBAT]""
- IF '$DATA(^DGCR(399.3,IBAT,0))
- SET IBER=IBER_"IB059;"
- +27 IF IBAT]""
- IF $DATA(^DGCR(399.3,IBAT,0))
- IF '$PIECE(^(0),"^",6)
- SET IBER=IBER_"IB059;"
- SET IBAT=""
- +28 ;I IBAT]"",$D(^DGCR(399.3,IBAT,0)) S IBARTP=$P(^PRCA(430.2,$P(^DGCR(399.3,IBAT,0),"^",6),0),"^",6)
- +29 IF IBAT]""
- IF $PIECE($GET(^DGCR(399.3,IBAT,0)),"^",6)
- SET IBARTP=$PIECE($$CATN^PRCAFN($PIECE(^DGCR(399.3,IBAT,0),"^",6)),"^",3)
- +30 ;Check that AR catagory expects same debtor as defined in who's respon.
- +31 IF $DATA(IBARTP)
- IF IBWHO="i"&(IBARTP'="T")!(IBWHO="p"&("PC"'[IBARTP))!(IBWHO="o"&(IBARTP'="N"))
- SET IBER=IBER_"IB058;"
- +32 ;
- +33 ;Who's Responsible
- +34 IF IBWHO=""!($LENGTH(IBWHO)>1)!("iop"'[IBWHO)
- SET IBER=IBER_"IB065;"
- +35 IF IBWHO="i"
- IF '+IBNDM
- SET IBER=IBER_"IB054;"
- +36 IF IBWHO="o"
- IF '+$PIECE(IBNDM,"^",11)
- SET IBER=IBER_"IB053;"
- +37 ;
- +38 GOTO ^IBCBB1
