- 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 Apr 23, 2025@18:35:48 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
