| 1 | IBCREE1 ;ALB/ARH - RATES: CM ENTER/EDIT (CI) ; 16-MAY-1996
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,106,245**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EDITCI ; Enter/Edit Charge Items
|
|---|
| 6 | N IBCS0,IBBR0,IBBRFN,IBITEM,IBBRBI,IBDT,IBCIFN,IBX,DIE,DR,DA,X,Y
|
|---|
| 7 | ;
|
|---|
| 8 | CS I '$G(IBCSFN) S IBCSFN=+$$GETCS^IBCRU1 Q:IBCSFN'>0
|
|---|
| 9 | D DISPCS^IBCRU5(+IBCSFN)
|
|---|
| 10 | ;
|
|---|
| 11 | S IBCS0=$G(^IBE(363.1,+IBCSFN,0)),IBBRFN=$P(IBCS0,U,2)
|
|---|
| 12 | S IBBR0=$G(^IBE(363.3,+IBBRFN,0)),IBBRBI=$P(IBBR0,U,4)
|
|---|
| 13 | W !!,"Enter/edit a billable item (",$$BITM(IBBRBI),") for Charge Set ",$P(IBCS0,U,1)
|
|---|
| 14 | ;
|
|---|
| 15 | CI W ! S IBITEM=$$GETITEM^IBCRU1(IBCSFN,"",1) I +IBITEM<1 Q
|
|---|
| 16 | I '$$ITFILE^IBCRU2(IBBRBI,+IBITEM) W !!,$$BITM(IBBRBI)," ",$P(IBITEM,U,2)," CURRENTLY INACTIVE",!
|
|---|
| 17 | ;
|
|---|
| 18 | EF D DISPCI^IBCRU5(+IBCSFN,+IBITEM)
|
|---|
| 19 | S IBDT=$$GETDT^IBCRU1($G(IBDT)) I IBDT<1 S IBDT="" W " ... no change" G CI
|
|---|
| 20 | D SCRNDSPL
|
|---|
| 21 | ;
|
|---|
| 22 | S IBCIFN=$$FINDCI(+IBCSFN,+IBITEM,IBDT) I IBCIFN<0 G EF
|
|---|
| 23 | ;
|
|---|
| 24 | I IBCIFN>0 W !,?50,"Editing Charge Item!"
|
|---|
| 25 | ;
|
|---|
| 26 | I 'IBCIFN D I 'IBCIFN W !!,"A charge can not be added for this item!",! Q
|
|---|
| 27 | . S IBCIFN=$$ADDCI^IBCREF(+IBCSFN,+IBITEM,IBDT) W !,?50,"Adding a new Charge Item!"
|
|---|
| 28 | ;
|
|---|
| 29 | S DR=$$DR01(+$P(IBITEM,U,4))_";.03;.04;.05;.06"
|
|---|
| 30 | ;
|
|---|
| 31 | I $P(IBITEM,U,4)=81 S DR=DR_";.07"
|
|---|
| 32 | I +$P(IBBR0,U,6) S DR=DR_";.08"
|
|---|
| 33 | ;
|
|---|
| 34 | DIE S DIDEL=363.2,DIE="^IBA(363.2,",DA=+IBCIFN D ^DIE K DIE,DR,X,DIDEL
|
|---|
| 35 | ;
|
|---|
| 36 | I $D(DA),$D(Y)=0 S IBX=$$RQCI^IBCREU1(+IBCIFN) I +IBX D RQW S DR=".06" G DIE
|
|---|
| 37 | D DISPCSL^IBCRU5(+IBCSFN)
|
|---|
| 38 | G CI
|
|---|
| 39 | Q
|
|---|
| 40 | BITM(X) ; return external form of billable item
|
|---|
| 41 | S X=+$G(X) S X=$$EXPAND^IBCRU1(363.3,.04,X)
|
|---|
| 42 | Q X
|
|---|
| 43 | RQW ; write explanation of required fields
|
|---|
| 44 | W !!,"Enter either a Default Revenue Code for the Charge Set or a Revenue Code for",!,"this Charge Item:"
|
|---|
| 45 | W !," - a charge can not be added to a bill without a revenue code"
|
|---|
| 46 | W !," - no Revenue Code was added for this Charge Item and there is no"
|
|---|
| 47 | W !," Default Revenue code for the Charge Set."
|
|---|
| 48 | W !," - one or the other must be added before this charge will be used",!!
|
|---|
| 49 | W !!,"You may enter a revenue code for the Charge Item now: (^ to exit)"
|
|---|
| 50 | Q
|
|---|
| 51 | FINDCI(IBCSFN,IBITEM,IBDT) ; find item to edit returns CIIFN or 0 (new) or -1 (error)
|
|---|
| 52 | ;
|
|---|
| 53 | N IBY,IBI,IBCNT,DIR,X,Y,IBARR S IBY=-1
|
|---|
| 54 | S IBI=$O(^IBA(363.2,"AIVDTS"_IBCSFN,+IBITEM,-IBDT,0)) I 'IBI S IBY=0 G FCQ ; none found
|
|---|
| 55 | ;
|
|---|
| 56 | S (IBI,IBCNT)=0 F S IBI=$O(^IBA(363.2,"AIVDTS"_IBCSFN,+IBITEM,-IBDT,+IBI)) Q:'IBI D
|
|---|
| 57 | . S IBCNT=IBCNT+1,IBARR(IBCNT)=IBI D DISPCIL^IBCRU5(IBI,IBCNT)
|
|---|
| 58 | I +IBCNT S DIR(0)="NO^1:"_IBCNT D ^DIR I Y>0 S IBY=$G(IBARR(Y))
|
|---|
| 59 | I '$D(DTOUT),'$D(DUOUT),IBY<1 S DIR(0)="Y",DIR("A")="Add a new Charge Item? " S DIR("B")="Y" D ^DIR I Y=1 S IBY=0
|
|---|
| 60 | FCQ Q IBY
|
|---|
| 61 | ;
|
|---|
| 62 | DR01(FILE) ; return DR string for editing the .01 field of charge item
|
|---|
| 63 | N IBX S IBX=""
|
|---|
| 64 | I +$G(FILE) S IBX="S DIC(""V"")=""I +Y(0)="_+FILE_""";.01;K DIC(""V"")"
|
|---|
| 65 | Q IBX
|
|---|
| 66 | ;
|
|---|
| 67 | SCRNDSPL ; if this edit is called from the screen return the items and dates edited so screen can be
|
|---|
| 68 | ; redisplayed with the new/edited items
|
|---|
| 69 | I $D(IBSRNITM) S IBSRNITM=IBITEM
|
|---|
| 70 | I $D(IBSRNBDT),IBSRNBDT>IBDT S IBSRNBDT=IBDT
|
|---|
| 71 | I $D(IBSRNEDT),+IBSRNEDT,IBSRNEDT<IBDT S IBSRNEDT=IBDT
|
|---|
| 72 | Q
|
|---|
