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
