- 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
