IBECEA1 ;ALB/RLW - Cancel/Edit/Add... Action Entry Points ; 12-JUN-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
PASS ; 'Pass a Charge' Entry Action (added by Jim Moore 4/30/92)
N C,IBII,IBNOS,IBND,IBMSG,IBY,IBLINE,IBSTAT,IBAFY,IBATYP
N IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBNOS2,Y
S VALMBCK="R" D EN^VALM2($G(XQORNOD(0)))
S IBII="" F S IBII=$O(VALMY(IBII)) Q:'IBII D L -^IB(IBNOS2) D MSG
.S IBY=1,IBLINE=^TMP("IBACM",$J,IBII,0)
.S (IBNOS,IBNOS2)=+$P(^TMP("IBACMIDX",$J,IBII),"^",4)
.;
.; - perform up-front edits
.L +^IB(IBNOS2):5 I '$T S IBMSG="was not passed - record not available, please try again" Q
.S IBND=$G(^IB(IBNOS2,0)) 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
.;
.; - pass charge to AR and update list
.D ^IBR S IBY=$G(Y)
.S IBND=$G(^IB(IBNOS2,0))
.S (IBSTAT,Y)=$P(IBND,"^",5),C=$P($G(^DD(350,.05,0)),"^",2) D Y^DIQ
.S IBLINE=$$SETSTR^VALM1(Y,IBLINE,+$P(VALMDDF("STATUS"),"^",2),+$P(VALMDDF("STATUS"),"^",3))
.S IBLINE=$$SETSTR^VALM1($P($P(IBND,"^",11),"-",2),IBLINE,+$P(VALMDDF("BILL#"),"^",2),+$P(VALMDDF("BILL#"),"^",3))
.S ^TMP("IBACM",$J,IBII,0)=IBLINE
.S IBMSG=$S(+IBY=-1:"was not passed -",IBSTAT=8:"has now been placed ON HOLD",1:"has now been passed")
.;
.; - if there is no active billing clock, add one
.I $P(IBND,"^",14),'$D(^IBE(351,"ACT",DFN)) D
..W !,"This patient has no active billing clock. Adding a new one... "
..S IBCLDT=$P(IBND,"^",14) D CLADD^IBAUTL3 W $S(IBY>0:"done.",1:"error (see msg)")
Q
;
MSG ; Display results message.
W !,"Charge #"_IBII_" "_IBMSG I +IBY=-1 D ^IBAERR1
W ! S DIR(0)="E" D ^DIR K DIR W !
Q
;
;
ADD ; 'Add a Charge' Entry Action
G ^IBECEA3
;
UPD ; 'Edit a Charge' Entry Action
S IBAUPD=1
;
CAN ; 'Cancel a Charge' Entry Action
D EN^VALM2(IBNOD(0)) I '$O(VALMY(0)) S VALMBCK="" G CANQ
S (IBNBR,IBCOMMIT)=0,VALMBCK="R"
F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D ^@$S($G(IBAUPD):"IBECEA2",1:"IBECEA4")
I IBCOMMIT S IBBG=VALMBG W !,"Rebuilding list of charges..." D ARRAY^IBECEA0 S VALMBG=IBBG
K IBBG,IBNBR,IBAUPD,IBCOMMIT
CANQ Q
;
PAUSE ; Keep this around for awhile.
W ! S DIR(0)="E" D ^DIR K DIR W !
Q
IBECEA1 ;ALB/RLW - Cancel/Edit/Add... Action Entry Points ; 12-JUN-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
PASS ; 'Pass a Charge' Entry Action (added by Jim Moore 4/30/92)
+1 NEW C,IBII,IBNOS,IBND,IBMSG,IBY,IBLINE,IBSTAT,IBAFY,IBATYP
+2 NEW IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBNOS2,Y
+3 SET VALMBCK="R"
DO EN^VALM2($GET(XQORNOD(0)))
+4 SET IBII=""
FOR
SET IBII=$ORDER(VALMY(IBII))
IF 'IBII
QUIT
Begin DoDot:1
+5 SET IBY=1
SET IBLINE=^TMP("IBACM",$JOB,IBII,0)
+6 SET (IBNOS,IBNOS2)=+$PIECE(^TMP("IBACMIDX",$JOB,IBII),"^",4)
+7 ;
+8 ; - perform up-front edits
+9 LOCK +^IB(IBNOS2):5
IF '$TEST
SET IBMSG="was not passed - record not available, please try again"
QUIT
+10 SET IBND=$GET(^IB(IBNOS2,0))
IF IBND=""
SET IBMSG="was not passed - record missing the zeroth node"
QUIT
+11 IF $PIECE(IBND,"^",12)
SET IBMSG="was not passed - the charge already has an AR Transaction Number"
QUIT
+12 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
+13 IF $PIECE(IBND,"^",7)'>0
SET IBMSG="was not passed - there is no charge amount"
QUIT
+14 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
+15 ;
+16 ; - pass charge to AR and update list
+17 DO ^IBR
SET IBY=$GET(Y)
+18 SET IBND=$GET(^IB(IBNOS2,0))
+19 SET (IBSTAT,Y)=$PIECE(IBND,"^",5)
SET C=$PIECE($GET(^DD(350,.05,0)),"^",2)
DO Y^DIQ
+20 SET IBLINE=$$SETSTR^VALM1(Y,IBLINE,+$PIECE(VALMDDF("STATUS"),"^",2),+$PIECE(VALMDDF("STATUS"),"^",3))
+21 SET IBLINE=$$SETSTR^VALM1($PIECE($PIECE(IBND,"^",11),"-",2),IBLINE,+$PIECE(VALMDDF("BILL#"),"^",2),+$PIECE(VALMDDF("BILL#"),"^",3))
+22 SET ^TMP("IBACM",$JOB,IBII,0)=IBLINE
+23 SET IBMSG=$SELECT(+IBY=-1:"was not passed -",IBSTAT=8:"has now been placed ON HOLD",1:"has now been passed")
+24 ;
+25 ; - if there is no active billing clock, add one
+26 IF $PIECE(IBND,"^",14)
IF '$DATA(^IBE(351,"ACT",DFN))
Begin DoDot:2
+27 WRITE !,"This patient has no active billing clock. Adding a new one... "
+28 SET IBCLDT=$PIECE(IBND,"^",14)
DO CLADD^IBAUTL3
WRITE $SELECT(IBY>0:"done.",1:"error (see msg)")
End DoDot:2
End DoDot:1
LOCK -^IB(IBNOS2)
DO MSG
+29 QUIT
+30 ;
MSG ; Display results message.
+1 WRITE !,"Charge #"_IBII_" "_IBMSG
IF +IBY=-1
DO ^IBAERR1
+2 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
+3 QUIT
+4 ;
+5 ;
ADD ; 'Add a Charge' Entry Action
+1 GOTO ^IBECEA3
+2 ;
UPD ; 'Edit a Charge' Entry Action
+1 SET IBAUPD=1
+2 ;
CAN ; 'Cancel a Charge' Entry Action
+1 DO EN^VALM2(IBNOD(0))
IF '$ORDER(VALMY(0))
SET VALMBCK=""
GOTO CANQ
+2 SET (IBNBR,IBCOMMIT)=0
SET VALMBCK="R"
+3 FOR
SET IBNBR=$ORDER(VALMY(IBNBR))
IF 'IBNBR
QUIT
DO ^@$SELECT($GET(IBAUPD):"IBECEA2",1:"IBECEA4")
+4 IF IBCOMMIT
SET IBBG=VALMBG
WRITE !,"Rebuilding list of charges..."
DO ARRAY^IBECEA0
SET VALMBG=IBBG
+5 KILL IBBG,IBNBR,IBAUPD,IBCOMMIT
CANQ QUIT
+1 ;
PAUSE ; Keep this around for awhile.
+1 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
+2 QUIT
