IBECEA22 ;ALB/CPM-Cancel/Edit/Add... Edit Utilities;23-APR-93
;;2.0;INTEGRATED BILLING;**150,183,563**;21-MAR-94;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
UPCHG(P7,P6,P14,P15,P22) ; Update the incomplete charge and pass to AR?
; Input: P7 -- New amount [required]
; P6 -- New Units [optional]
; P14 -- New Bill From date [optional]
; P15 -- New Bill To date [optional]
; P22 -- New Tier Level [optional]
N DA,DIE,DIR,DIRUT,DR,DUOUT,DTOUT,X,Y
S DIR(0)="Y",DIR("A")="Okay to update this charge and pass it to Accounts Receivable"
S DIR("?")="Enter 'Y' or 'YES' to update and pass the charge, or 'N', or '^' to quit."
D ^DIR I 'Y!($D(DIRUT))!($D(DUOUT)) S IBY=-1 Q
W !,"Updating the incomplete charge and passing to Accounts Receivable... "
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 S:$G(P22) $P(^(0),"^",22)=P22
;
; - update copay account records
D:$P(IBND,"^",19) UPCHG^IBARXMN($P(IBND,"^",19),P6,P7)
D PASSCH I IBY>0 W "done." S IBCOMMIT=1
Q
;
PASS ; Okay to pass charge to Accounts Receivable?
N DIR,DIRUT,DUOUT,DTOUT
S DIR(0)="Okay to pass this charge to Accounts Receivable",DIR(0)="Y"
S DIR("?")="Enter 'Y' or 'YES' to pass this charge to AR, or 'N' or '^' to quit."
D ^DIR I Y W !,"Passing the charge to Accounts Receivable... " D PASSCH I IBY>0 W "done." S IBCOMMIT=1
Q
;
PASSCH ; Pass charge to Accounts Receivable.
I $G(IBXA)=5 D FILER^IBARXMA(IBN) ; transmit cap info
N IBSERV S IBNOS=IBN D ^IBR S IBY=Y
Q
;
CHCL ; Update charge and clocks.
D UPCHG(IBCHG,IBUNIT,IBFR,IBTO)
I IBY>0 D CLOCK^IBECEAU(IBDOLA-IBCLDOL,IBCLDAY,IBDAYA-IBCLDAY) S IBY=-1
Q
;
UPD ; Build an 'update' transaction.
N DA,DIK
S IBATYP=$P($G(^IBE(350.1,+$P(IBUPD,"^",3),0)),"^",7) I IBATYP="" S IBY="-1^IB022" G UPDQ
S IBSEQNO=$P($G(^IBE(350.1,IBATYP,0)),"^",5) I 'IBSEQNO S IBY="-1^IB023" G UPDQ
W !!,"Building the updated transaction... "
D ADD^IBAUTL I Y<1 S IBY=Y G UPDQ
S $P(IBUPD,"^",14,15)=IBFR_"^"_IBTO
S:IBXA'=5 IBUPD=$P(IBUPD,"^",1,16)
S $P(IBUPD,"^",3)=IBATYP,$P(IBUPD,"^",5)=1,$P(IBUPD,"^",6,7)=IBUNIT_"^"_IBCHG,$P(IBUPD,"^",12)=""
S:$D(IBAM) $P(IBUPD,"^",19)=IBAM
S $P(IBUPD,"^",21)=$S($G(IBGMTR):1,1:"") ; GMT Related
S:$G(IBTIER) $P(IBUPD,"^",22)=IBTIER
S ^IB(IBN,0)=IBUPD,$P(^(1),"^")=DUZ S DA=IBN,DIK="^IB(" D IX1^DIK
D PASSCH W:IBY>0 "done."
UPDQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA22 2489 printed Nov 22, 2024@17:31:19 Page 2
IBECEA22 ;ALB/CPM-Cancel/Edit/Add... Edit Utilities;23-APR-93
+1 ;;2.0;INTEGRATED BILLING;**150,183,563**;21-MAR-94;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
UPCHG(P7,P6,P14,P15,P22) ; Update the incomplete charge and pass to AR?
+1 ; Input: P7 -- New amount [required]
+2 ; P6 -- New Units [optional]
+3 ; P14 -- New Bill From date [optional]
+4 ; P15 -- New Bill To date [optional]
+5 ; P22 -- New Tier Level [optional]
+6 NEW DA,DIE,DIR,DIRUT,DR,DUOUT,DTOUT,X,Y
+7 SET DIR(0)="Y"
SET DIR("A")="Okay to update this charge and pass it to Accounts Receivable"
+8 SET DIR("?")="Enter 'Y' or 'YES' to update and pass the charge, or 'N', or '^' to quit."
+9 DO ^DIR
IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
SET IBY=-1
QUIT
+10 WRITE !,"Updating the incomplete charge and passing to Accounts Receivable... "
+11 SET $PIECE(^IB(IBN,0),"^",7)=P7
if $GET(P6)
SET $PIECE(^(0),"^",6)=P6
if $GET(P14)
SET $PIECE(^(0),"^",14)=P14
if $GET(P15)
SET $PIECE(^(0),"^",15)=P15
if $GET(P22)
SET $PIECE(^(0),"^",22)=P22
+12 ;
+13 ; - update copay account records
+14 if $PIECE(IBND,"^",19)
DO UPCHG^IBARXMN($PIECE(IBND,"^",19),P6,P7)
+15 DO PASSCH
IF IBY>0
WRITE "done."
SET IBCOMMIT=1
+16 QUIT
+17 ;
PASS ; Okay to pass charge to Accounts Receivable?
+1 NEW DIR,DIRUT,DUOUT,DTOUT
+2 SET DIR(0)="Okay to pass this charge to Accounts Receivable"
SET DIR(0)="Y"
+3 SET DIR("?")="Enter 'Y' or 'YES' to pass this charge to AR, or 'N' or '^' to quit."
+4 DO ^DIR
IF Y
WRITE !,"Passing the charge to Accounts Receivable... "
DO PASSCH
IF IBY>0
WRITE "done."
SET IBCOMMIT=1
+5 QUIT
+6 ;
PASSCH ; Pass charge to Accounts Receivable.
+1 ; transmit cap info
IF $GET(IBXA)=5
DO FILER^IBARXMA(IBN)
+2 NEW IBSERV
SET IBNOS=IBN
DO ^IBR
SET IBY=Y
+3 QUIT
+4 ;
CHCL ; Update charge and clocks.
+1 DO UPCHG(IBCHG,IBUNIT,IBFR,IBTO)
+2 IF IBY>0
DO CLOCK^IBECEAU(IBDOLA-IBCLDOL,IBCLDAY,IBDAYA-IBCLDAY)
SET IBY=-1
+3 QUIT
+4 ;
UPD ; Build an 'update' transaction.
+1 NEW DA,DIK
+2 SET IBATYP=$PIECE($GET(^IBE(350.1,+$PIECE(IBUPD,"^",3),0)),"^",7)
IF IBATYP=""
SET IBY="-1^IB022"
GOTO UPDQ
+3 SET IBSEQNO=$PIECE($GET(^IBE(350.1,IBATYP,0)),"^",5)
IF 'IBSEQNO
SET IBY="-1^IB023"
GOTO UPDQ
+4 WRITE !!,"Building the updated transaction... "
+5 DO ADD^IBAUTL
IF Y<1
SET IBY=Y
GOTO UPDQ
+6 SET $PIECE(IBUPD,"^",14,15)=IBFR_"^"_IBTO
+7 if IBXA'=5
SET IBUPD=$PIECE(IBUPD,"^",1,16)
+8 SET $PIECE(IBUPD,"^",3)=IBATYP
SET $PIECE(IBUPD,"^",5)=1
SET $PIECE(IBUPD,"^",6,7)=IBUNIT_"^"_IBCHG
SET $PIECE(IBUPD,"^",12)=""
+9 if $DATA(IBAM)
SET $PIECE(IBUPD,"^",19)=IBAM
+10 ; GMT Related
SET $PIECE(IBUPD,"^",21)=$SELECT($GET(IBGMTR):1,1:"")
+11 if $GET(IBTIER)
SET $PIECE(IBUPD,"^",22)=IBTIER
+12 SET ^IB(IBN,0)=IBUPD
SET $PIECE(^(1),"^")=DUZ
SET DA=IBN
SET DIK="^IB("
DO IX1^DIK
+13 DO PASSCH
if IBY>0
WRITE "done."
UPDQ QUIT
