[613] | 1 | IBECEA22 ;ALB/CPM-Cancel/Edit/Add... Edit Utilities;23-APR-93
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**150,183**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | UPCHG(P7,P6,P14,P15) ; Update the incomplete charge and pass to AR?
|
---|
| 6 | ; Input: P7 -- New amount [required]
|
---|
| 7 | ; P6 -- New Units [optional]
|
---|
| 8 | ; P14 -- New Bill From date [optional]
|
---|
| 9 | ; P15 -- New Bill To date [optional]
|
---|
| 10 | N DA,DIE,DIR,DIRUT,DR,DUOUT,DTOUT,X,Y
|
---|
| 11 | S DIR(0)="Y",DIR("A")="Okay to update this charge and pass it to Accounts Receivable"
|
---|
| 12 | S DIR("?")="Enter 'Y' or 'YES' to update and pass the charge, or 'N', or '^' to quit."
|
---|
| 13 | D ^DIR I 'Y!($D(DIRUT))!($D(DUOUT)) S IBY=-1 Q
|
---|
| 14 | W !,"Updating the incomplete charge and passing to Accounts Receivable... "
|
---|
| 15 | S $P(^IB(IBN,0),"^",7)=P7 S:$G(P6) $P(^(0),"^",6)=P6 S:$G(P14) $P(^(0),"^",14)=P14 S:$G(P15) $P(^(0),"^",15)=P15
|
---|
| 16 | ;
|
---|
| 17 | ; - update copay account records
|
---|
| 18 | D:$P(IBND,"^",19) UPCHG^IBARXMN($P(IBND,"^",19),P6,P7)
|
---|
| 19 | D PASSCH I IBY>0 W "done." S IBCOMMIT=1
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | PASS ; Okay to pass charge to Accounts Receivable?
|
---|
| 23 | N DIR,DIRUT,DUOUT,DTOUT
|
---|
| 24 | S DIR(0)="Okay to pass this charge to Accounts Receivable",DIR(0)="Y"
|
---|
| 25 | S DIR("?")="Enter 'Y' or 'YES' to pass this charge to AR, or 'N' or '^' to quit."
|
---|
| 26 | D ^DIR I Y W !,"Passing the charge to Accounts Receivable... " D PASSCH I IBY>0 W "done." S IBCOMMIT=1
|
---|
| 27 | Q
|
---|
| 28 | ;
|
---|
| 29 | PASSCH ; Pass charge to Accounts Receivable.
|
---|
| 30 | I $G(IBXA)=5 D FILER^IBARXMA(IBN) ; transmit cap info
|
---|
| 31 | N IBSERV S IBNOS=IBN D ^IBR S IBY=Y
|
---|
| 32 | Q
|
---|
| 33 | ;
|
---|
| 34 | CHCL ; Update charge and clocks.
|
---|
| 35 | D UPCHG(IBCHG,IBUNIT,IBFR,IBTO)
|
---|
| 36 | I IBY>0 D CLOCK^IBECEAU(IBDOLA-IBCLDOL,IBCLDAY,IBDAYA-IBCLDAY) S IBY=-1
|
---|
| 37 | Q
|
---|
| 38 | ;
|
---|
| 39 | UPD ; Build an 'update' transaction.
|
---|
| 40 | N DA,DIK
|
---|
| 41 | S IBATYP=$P($G(^IBE(350.1,+$P(IBUPD,"^",3),0)),"^",7) I IBATYP="" S IBY="-1^IB022" G UPDQ
|
---|
| 42 | S IBSEQNO=$P($G(^IBE(350.1,IBATYP,0)),"^",5) I 'IBSEQNO S IBY="-1^IB023" G UPDQ
|
---|
| 43 | W !!,"Building the updated transaction... "
|
---|
| 44 | D ADD^IBAUTL I Y<1 S IBY=Y G UPDQ
|
---|
| 45 | S $P(IBUPD,"^",3)=IBATYP,$P(IBUPD,"^",5)=1,$P(IBUPD,"^",6,7)=IBUNIT_"^"_IBCHG,$P(IBUPD,"^",12)=""
|
---|
| 46 | S:IBXA'=5 $P(IBUPD,"^",14,15)=IBFR_"^"_IBTO,IBUPD=$P(IBUPD,"^",1,16)
|
---|
| 47 | S:$D(IBAM) $P(IBUPD,"^",19)=IBAM
|
---|
| 48 | S $P(IBUPD,"^",21)=$S($G(IBGMTR):1,1:"") ; GMT Related
|
---|
| 49 | S ^IB(IBN,0)=IBUPD,$P(^(1),"^")=DUZ S DA=IBN,DIK="^IB(" D IX1^DIK
|
---|
| 50 | D PASSCH W:IBY>0 "done."
|
---|
| 51 | UPDQ Q
|
---|