IBAMTV32 ;ALB/CPM - RELEASE PENDING CHARGES ACTIONS ; 03-JUN-94
;;Version 2.0 ; INTEGRATED BILLING ;**15**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
PC ; 'Pass Charges' entry action.
N IBCOMMIT,IBNBR,IBY,IBMSG,IBNOS,IBNOSX,IBND,IBY,IBMSG,IBDUZ,IBSTAT
N IBAFY,IBATYP,IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBBG
S IBCOMMIT=0 D EN^VALM2($G(XQORNOD(0))) I '$O(VALMY(0)) G PCQ
S IBNBR="" F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D D MSG
.S (IBNOS,IBNOSX)=^TMP("IBAMTV31",$J,"IDX",IBNBR,IBNBR)
.S IBND=$G(^IB(IBNOS,0)),IBY=1,IBMSG="",IBDUZ=DUZ
.I 'IBND S IBMSG="was not passed - record missing the zeroth node" Q
.I $P(IBND,"^",12) S IBMSG="was not passed - the charge already has an AR Transaction Number" Q
.S IBSTAT=+$P(IBND,"^",5) I $P($G(^IBE(350.21,IBSTAT,0)),"^",4) S IBMSG="was not passed - the status indicates that the charge is billed" Q
.I $P(IBND,"^",7)'>0 S IBMSG="was not passed - there is no charge amount" Q
.S IBSEQNO=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5) I 'IBSEQNO S IBMSG="was not passed (Bulletin will be generated)",IBY="-1^IB023" Q
.;
.; - okay to pass charge?
.D PROC^IBECEAU4("pass") I IBY<0 S IBY=1 Q
.;
.; - pass charge to AR and update list
.D ^IBR S IBY=$G(Y)
.S IBND=$G(^IB(IBNOSX,0)),IBCOMMIT=1
.S IBMSG=$S(IBY<0:"was not passed - see error message (bulletin).",$P(IBND,"^",5)=8:"has now been placed ON HOLD (patient has active insurance).",1:"has been passed to Accounts Receivable.")
.;
.; - update IVM
.D IVM(IBND)
;
PCQ D PAUSE^VALM1
S VALMBCK=$S(IBCOMMIT:"R",1:"")
I IBCOMMIT S IBBG=VALMBG D INIT^IBAMTV31 S VALMBG=IBBG
Q
;
;
CC ; 'Cancel Charges' entry action.
N IBCHG,IBCRES,IBIL,IBND,IBSEQNO,IBUNIT,IBATYP,IBDUZ,IBBG
N IBN,IBY,IBPARNT,IBH,IBCANTR,IBXA,IBFR,IBCANC,IBCOMMIT,IBNBR
D FULL^VALM1
S IBCOMMIT=0 D EN^VALM2($G(XQORNOD(0))) I '$O(VALMY(0)) G CCQ
S IBNBR="" F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D
.S IBN=^TMP("IBAMTV31",$J,"IDX",IBNBR,IBNBR),IBDUZ=DUZ,IBY=0 Q:'IBN
.;
.; - perform up-front edits
.D CED^IBECEAU4(IBN) Q:IBY<0
.I 'IBH,IBIL="" S IBY="-1^IB024" Q
.;
.; - ask for the cancellation reason
.D REAS^IBECEAU2("C") Q:IBCRES<0
.;
.; - okay to proceed?
.D PROC^IBECEAU4("cancel") I IBY<0 S IBY=1 Q
.;
.; - handle incomplete and regular transactions
.D CANC^IBECEAU4(IBN,IBCRES,1) Q:IBY<0
.;
.S IBCOMMIT=1,IBMSG="has been cancelled." D MSG
.;
.; - handle the clock
.D CLSTR^IBECEAU1(DFN,$P(IBND,"^",14))
.I 'IBCLDA W !!,"Please note that there is no billing clock which would cover this charge.",!,"Be sure that this patient's billing clock is correct." Q
.D CLDSP^IBECEAU1(IBCLST,$$PT^IBEFUNC(DFN))
.W !!,"Since the billing clock was updated when the charge was originally built,"
.W !,"you may now need to update this clock since the charge has been cancelled."
;
CCQ D PAUSE^VALM1
S VALMBCK="R"
I IBCOMMIT S IBBG=VALMBG D INIT^IBAMTV31 S VALMBG=IBBG
Q
;
;
MSG ; Display results message.
I IBMSG]"" W !,"Charge #"_IBNBR_" "_IBMSG I +IBY=-1 D ^IBAERR1
Q
;
;
IVM(IBND) ; Pass billing information to the IVM package.
; This tag is also called by IBECEA1 (Pass a Charge)
;
; Input: IBND -- Zeroth node of IB action in file #350
;
Q:'$G(IBND)
D REV^IVMUFNC3(+IBND,+$P(IBND,"^",2),$S($P(IBND,"^",8)["OPT COPAY":2,1:1),$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["PER DIEM":3,1:2),$P(IBND,"^",14),$P(IBND,"^",15),$P(IBND,"^",7),$P(IBND,"^",5)=8)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTV32 3510 printed Apr 09, 2024@21:21:05 Page 2
IBAMTV32 ;ALB/CPM - RELEASE PENDING CHARGES ACTIONS ; 03-JUN-94
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**15**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
PC ; 'Pass Charges' entry action.
+1 NEW IBCOMMIT,IBNBR,IBY,IBMSG,IBNOS,IBNOSX,IBND,IBY,IBMSG,IBDUZ,IBSTAT
+2 NEW IBAFY,IBATYP,IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBBG
+3 SET IBCOMMIT=0
DO EN^VALM2($GET(XQORNOD(0)))
IF '$ORDER(VALMY(0))
GOTO PCQ
+4 SET IBNBR=""
FOR
SET IBNBR=$ORDER(VALMY(IBNBR))
if 'IBNBR
QUIT
Begin DoDot:1
+5 SET (IBNOS,IBNOSX)=^TMP("IBAMTV31",$JOB,"IDX",IBNBR,IBNBR)
+6 SET IBND=$GET(^IB(IBNOS,0))
SET IBY=1
SET IBMSG=""
SET IBDUZ=DUZ
+7 IF 'IBND
SET IBMSG="was not passed - record missing the zeroth node"
QUIT
+8 IF $PIECE(IBND,"^",12)
SET IBMSG="was not passed - the charge already has an AR Transaction Number"
QUIT
+9 SET IBSTAT=+$PIECE(IBND,"^",5)
IF $PIECE($GET(^IBE(350.21,IBSTAT,0)),"^",4)
SET IBMSG="was not passed - the status indicates that the charge is billed"
QUIT
+10 IF $PIECE(IBND,"^",7)'>0
SET IBMSG="was not passed - there is no charge amount"
QUIT
+11 SET IBSEQNO=$PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^",5)
IF 'IBSEQNO
SET IBMSG="was not passed (Bulletin will be generated)"
SET IBY="-1^IB023"
QUIT
+12 ;
+13 ; - okay to pass charge?
+14 DO PROC^IBECEAU4("pass")
IF IBY<0
SET IBY=1
QUIT
+15 ;
+16 ; - pass charge to AR and update list
+17 DO ^IBR
SET IBY=$GET(Y)
+18 SET IBND=$GET(^IB(IBNOSX,0))
SET IBCOMMIT=1
+19 SET IBMSG=$SELECT(IBY<0:"was not passed - see error message (bulletin).",$PIECE(IBND,"^",5)=8:"has now been placed ON HOLD (patient has active insurance).",1:"has been passed to Accounts Receivable.")
+20 ;
+21 ; - update IVM
+22 DO IVM(IBND)
End DoDot:1
DO MSG
+23 ;
PCQ DO PAUSE^VALM1
+1 SET VALMBCK=$SELECT(IBCOMMIT:"R",1:"")
+2 IF IBCOMMIT
SET IBBG=VALMBG
DO INIT^IBAMTV31
SET VALMBG=IBBG
+3 QUIT
+4 ;
+5 ;
CC ; 'Cancel Charges' entry action.
+1 NEW IBCHG,IBCRES,IBIL,IBND,IBSEQNO,IBUNIT,IBATYP,IBDUZ,IBBG
+2 NEW IBN,IBY,IBPARNT,IBH,IBCANTR,IBXA,IBFR,IBCANC,IBCOMMIT,IBNBR
+3 DO FULL^VALM1
+4 SET IBCOMMIT=0
DO EN^VALM2($GET(XQORNOD(0)))
IF '$ORDER(VALMY(0))
GOTO CCQ
+5 SET IBNBR=""
FOR
SET IBNBR=$ORDER(VALMY(IBNBR))
if 'IBNBR
QUIT
Begin DoDot:1
+6 SET IBN=^TMP("IBAMTV31",$JOB,"IDX",IBNBR,IBNBR)
SET IBDUZ=DUZ
SET IBY=0
if 'IBN
QUIT
+7 ;
+8 ; - perform up-front edits
+9 DO CED^IBECEAU4(IBN)
if IBY<0
QUIT
+10 IF 'IBH
IF IBIL=""
SET IBY="-1^IB024"
QUIT
+11 ;
+12 ; - ask for the cancellation reason
+13 DO REAS^IBECEAU2("C")
if IBCRES<0
QUIT
+14 ;
+15 ; - okay to proceed?
+16 DO PROC^IBECEAU4("cancel")
IF IBY<0
SET IBY=1
QUIT
+17 ;
+18 ; - handle incomplete and regular transactions
+19 DO CANC^IBECEAU4(IBN,IBCRES,1)
if IBY<0
QUIT
+20 ;
+21 SET IBCOMMIT=1
SET IBMSG="has been cancelled."
DO MSG
+22 ;
+23 ; - handle the clock
+24 DO CLSTR^IBECEAU1(DFN,$PIECE(IBND,"^",14))
+25 IF 'IBCLDA
WRITE !!,"Please note that there is no billing clock which would cover this charge.",!,"Be sure that this patient's billing clock is correct."
QUIT
+26 DO CLDSP^IBECEAU1(IBCLST,$$PT^IBEFUNC(DFN))
+27 WRITE !!,"Since the billing clock was updated when the charge was originally built,"
+28 WRITE !,"you may now need to update this clock since the charge has been cancelled."
End DoDot:1
+29 ;
CCQ DO PAUSE^VALM1
+1 SET VALMBCK="R"
+2 IF IBCOMMIT
SET IBBG=VALMBG
DO INIT^IBAMTV31
SET VALMBG=IBBG
+3 QUIT
+4 ;
+5 ;
MSG ; Display results message.
+1 IF IBMSG]""
WRITE !,"Charge #"_IBNBR_" "_IBMSG
IF +IBY=-1
DO ^IBAERR1
+2 QUIT
+3 ;
+4 ;
IVM(IBND) ; Pass billing information to the IVM package.
+1 ; This tag is also called by IBECEA1 (Pass a Charge)
+2 ;
+3 ; Input: IBND -- Zeroth node of IB action in file #350
+4 ;
+5 if '$GET(IBND)
QUIT
+6 DO REV^IVMUFNC3(+IBND,+$PIECE(IBND,"^",2),$SELECT($PIECE(IBND,"^",8)["OPT COPAY":2,1:1),$SELECT($PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^")["PER DIEM":3,1:2),$PIECE(IBND,"^",14),$PIECE(IBND,"^",15),$PIECE(IBND,"^",7),$PIECE(IBND,"^",5)=
8)
+7 QUIT
