source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCREE1.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBCREE1 ;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 ;
5EDITCI ; Enter/Edit Charge Items
6 N IBCS0,IBBR0,IBBRFN,IBITEM,IBBRBI,IBDT,IBCIFN,IBX,DIE,DR,DA,X,Y
7 ;
8CS 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 ;
15CI 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 ;
18EF 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 ;
34DIE 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
40BITM(X) ; return external form of billable item
41 S X=+$G(X) S X=$$EXPAND^IBCRU1(363.3,.04,X)
42 Q X
43RQW ; 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
51FINDCI(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
60FCQ Q IBY
61 ;
62DR01(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 ;
67SCRNDSPL ; 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
Note: See TracBrowser for help on using the repository browser.