- IBECEA22 ;ALB/CPM - Cancel/Edit/Add... Edit Utilities ; 23-APR-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- UPCHG(P7,P6,P14,P15) ; 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]
- 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
- 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.
- 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,"^",3)=IBATYP,$P(IBUPD,"^",5)=1,$P(IBUPD,"^",6,7)=IBUNIT_"^"_IBCHG,$P(IBUPD,"^",12)=""
- S:IBXA'=5 $P(IBUPD,"^",14,15)=IBFR_"^"_IBTO,IBUPD=$P(IBUPD,"^",1,16)
- S ^IB(IBN,0)=IBUPD,$P(^(1),"^")=DUZ S DA=IBN,DIK="^IB(" D IX1^DIK
- D PASSCH W:IBY>0 "done."
- UPDQ Q
- IBECEA22 ;ALB/CPM - Cancel/Edit/Add... Edit Utilities ; 23-APR-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- UPCHG(P7,P6,P14,P15) ; 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 NEW DA,DIE,DIR,DIRUT,DR,DUOUT,DTOUT,X,Y
- +6 SET DIR(0)="Y"
- SET DIR("A")="Okay to update this charge and pass it to Accounts Receivable"
- +7 SET DIR("?")="Enter 'Y' or 'YES' to update and pass the charge, or 'N', or '^' to quit."
- +8 DO ^DIR
- IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
- SET IBY=-1
- QUIT
- +9 WRITE !,"Updating the incomplete charge and passing to Accounts Receivable... "
- +10 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
- +11 DO PASSCH
- IF IBY>0
- WRITE "done."
- SET IBCOMMIT=1
- +12 QUIT
- +13 ;
- 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 NEW IBSERV
- SET IBNOS=IBN
- DO ^IBR
- SET IBY=Y
- +2 QUIT
- +3 ;
- 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,"^",3)=IBATYP
- SET $PIECE(IBUPD,"^",5)=1
- SET $PIECE(IBUPD,"^",6,7)=IBUNIT_"^"_IBCHG
- SET $PIECE(IBUPD,"^",12)=""
- +7 IF IBXA'=5
- SET $PIECE(IBUPD,"^",14,15)=IBFR_"^"_IBTO
- SET IBUPD=$PIECE(IBUPD,"^",1,16)
- +8 SET ^IB(IBN,0)=IBUPD
- SET $PIECE(^(1),"^")=DUZ
- SET DA=IBN
- SET DIK="^IB("
- DO IX1^DIK
- +9 DO PASSCH
- IF IBY>0
- WRITE "done."
- UPDQ QUIT
