source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRBE.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1IBCRBE ;ALB/ARH - RATES: BILL ENTER/EDIT (RS/CS) SCREEN ; 22-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,106,245,287**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EDIT(IBIFN) ; ENTRY POINT from Enter/Edit a Bill option:
6 ; display available Schedules/Sets for a bill, allow the user to choose the ones to use,
7 ; then recalculate the bills charges
8 ;
9 N IBSRTARR,IBCHGARR,IBUCHGAR I '$G(IBIFN) G EDITQ
10 ;
11 I '$$DISPLAY(IBIFN,.IBSRTARR) G EDITQ
12 ;
13 I '$$SELCT(IBIFN,.IBSRTARR,.IBCHGARR) G EDITQ
14 ;
15 I $O(IBCHGARR(0)) D BILL^IBCRBC(IBIFN,.IBCHGARR)
16 ;
17 I $O(IBCHGARR(0)),$$SELITEMS^IBCRBEI(IBIFN,.IBCHGARR,.IBUCHGAR) D BILLITEM^IBCRBC(IBIFN,.IBUCHGAR)
18 ;
19EDITQ Q
20 ;
21DISPLAY(IBIFN,IBSRTARR) ; get list of all RS/CS combinations available for use on the bill
22 ; sort them in name order then display the results to the screen, returns 1 if some found
23 N IB0,IBU,IBC,IBRSARR K IBSRTARR S IBC=1
24 ;
25 S IB0=$G(^DGCR(399,+$G(IBIFN),0)) I IB0="" S IBC=0 G DISPQ
26 S IBU=$G(^DGCR(399,+$G(IBIFN),"U")) I 'IBU S IBC=0 G DISPQ
27 D RT^IBCRU3($P(IB0,U,7),+$P(IB0,U,5),$P(IBU,U,1,2),.IBRSARR)
28 ;
29 I 'IBRSARR D NONE($P(IB0,U,1),$P(IB0,U,7),+$P(IB0,U,5),$P(IB0,U,3)),WAIT S IBC=0 G DISPQ
30 ;
31 D SORTBRS(.IBRSARR,.IBSRTARR,$P(IB0,U,27)),DISPRS($P(IB0,U,7),$P(IB0,U,5),.IBSRTARR)
32 ;
33DISPQ Q IBC
34 ;
35SORTBRS(IBRSARR,IBSRTARR,IBBCT) ; return array in rs name, cs name sorted order with external form of data
36 ; input: IBRSARR(rate sched IFN,charge set IFN) = true if auto add
37 ; output: IBSRTARR = CNT of RS/CS to be auto added ^ total CNT
38 ; IBSRTARR(CNT) = rs IFN ^ cs IFN ^ rs name ^ cs name ^ auto add ^ unassoc event ^ chg type ^ disp set
39 ;
40 N IBRS,IBCS,IBRSN,IBCSN,IBAA,IBUA,IBCT,IBTCNT,IBACNT,IBLN,IBS,ARRX K IBSRTARR S IBBCT=+$G(IBBCT)
41 S IBRS=0 F S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS D
42 . S IBCS=0 F S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS D
43 .. S IBAA=IBRSARR(IBRS,IBCS),IBRSN=$P($G(^IBE(363,+IBRS,0)),U,1),IBCSN=$P($G(^IBE(363.1,+IBCS,0)),U,1)
44 .. S IBUA=$S($$CSBR^IBCRU3(IBCS)["UNASSOCIATE":1,1:0),IBCT=$P($G(^IBE(363.1,+IBCS,0)),U,4)
45 .. S IBS=$S('IBAA:2,(+IBBCT&(IBBCT'=IBCT)):1,1:" ")_$S(IBCT=1:"I",IBCT=2:"P",1:" ")
46 .. I IBRSN'="",IBCSN'="" S ARRX(IBS_IBRSN_IBRS_IBCS,IBCSN)=IBRS_U_IBCS_U_IBRSN_U_IBCSN_U_IBAA_U_IBUA_U_IBCT_U_IBS
47 ;
48 S (IBTCNT,IBACNT)=0,IBRSN="" F S IBRSN=$O(ARRX(IBRSN)) Q:IBRSN="" D
49 . S IBCSN="" F S IBCSN=$O(ARRX(IBRSN,IBCSN)) Q:IBCSN="" D
50 .. S IBLN=ARRX(IBRSN,IBCSN),IBTCNT=IBTCNT+1 I 'IBRSN S IBACNT=IBACNT+1
51 .. S IBSRTARR(IBTCNT)=IBLN
52 S IBSRTARR=IBACNT_U_IBTCNT
53 Q
54 ;
55DISPRS(RT,BT,IBSRTARR) ; display available rate schedules and charge sets for a bill
56 N RTN,IBCNT,IBLN,IBLAST S RTN=$P($G(^DGCR(399.3,+$G(RT),0)),U,1),BT=$G(BT)
57 W @IOF,!?5,"Rate Schedules available for an "_$S(BT>2:"Outpatient ",BT>0:"Inpatient ",1:"")_$E(RTN,1,27)_" bill"
58 W !,"------------------------------------------------------------------------------"
59 ;
60 S IBCNT=0 F S IBCNT=$O(IBSRTARR(IBCNT)) Q:'IBCNT D
61 . S IBLN=$G(IBSRTARR(IBCNT)) I +$P(IBLN,U,8)'=+$G(IBLAST) W ! S IBLAST=+$P(IBLN,U,8)
62 . W !,?3,IBCNT,")",?8,$P(IBLN,U,3),?31,$P(IBLN,U,4),?69,$S(+$P(IBLN,U,7)=1:"INST",$P(IBLN,U,7)=2:"PROF",1:""),?75,$S(+$P(IBLN,U,6):"s",1:""),?77,$S('$P(IBLN,U,5):"*",1:"")
63 ;
64 Q
65 ;
66SELCT(IBIFN,IBSRTARR,IBCHGARR) ; get the user selection of rs/cs charges to add to the bill
67 ; input: IBSRTARR = CNT of RS/CS to be auto added ^ total CNT
68 ; IBSRTARR(CNT) = rs IFN ^ cs IFN ^ rs name ^ cs name ^ Auto Add ^ unassoc event ^ chg type ^ disp set
69 ; output: IBCHGARR(rate sched IFN,charge set IFN) = 1 - add charges for rs/cs
70 ;
71 N IBCHNG,IBSEL,IBI,IBS,IBX,IBLN,DIR,DIRUT,DUOUT,DTOUT,X,Y K IBCHGARR S IBCHNG=0 I '$G(IBIFN) G SELCTQ
72 I '$O(IBSRTARR(0)) G SELCTQ
73 ;
74 S DIR("?")="Enter the number (1-"_+$P(IBSRTARR,U,2)_") preceding the Rate Schedule/Charge Sets that apply to this bill. All associated charges will be added to the bill."
75 S DIR("?",1)="* - these charges are available to be added to this bill if selected here,"
76 S DIR("?",2)=" but will not be added when the bills charges are automatically calculated."
77 S DIR("?",3)="s - the items these charges are associated with must be specifically"
78 S DIR("?",4)=" selected here, they do not relate to any item on the bill.",DIR("?",5)=" "
79 S DIR("?",6)="If the bill's charge type is exclusively institutional or professional then"
80 S DIR("?",7)="only sets of charges with a corresponding type will be added when the bills"
81 S DIR("?",8)="charges are automatically calculated. On this screen, these charges will be"
82 S DIR("?",9)="displayed in the first set and used as the selection default.",DIR("?",10)=" "
83 S DIR("??")="^D HELP^IBCRBE("_IBIFN_")"
84 S DIR("A")="Select Schedule Charges to ADD to the bill: " I +IBSRTARR S DIR("B")="1-"_+IBSRTARR
85 ;
86 W !! S DIR(0)="LOA^1:"_+$P(IBSRTARR,U,2) D ^DIR K DIR I 'Y!$D(DIRUT) G SELCTQ
87 ;
88 S IBX="" F S IBX=$O(Y(IBX)) Q:IBX="" D
89 . S IBSEL=Y(IBX) F IBI=1:1:100 S IBS=$P(IBSEL,",",IBI) Q:'IBS D
90 .. I $D(IBSRTARR(IBS)) S IBCHNG=1,IBLN=IBSRTARR(IBS),IBCHGARR(+IBLN,$P(IBLN,U,2))=1
91 ;
92SELCTQ Q IBCHNG
93 ;
94NONE(IBBN,RT,BT,EVDT) ; write message indicating no rate schedules defined for this bill
95 N IBRTN S BT=+$G(BT),EVDT=$G(EVDT),IBRTN=$P($G(^DGCR(399.3,+$G(RT),0)),U,1)
96 W !,?7 I +EVDT W !,?7,"On ",$$DATE^IBCRU1(+EVDT),", there are "
97 W "No Rate Schedules with charges defined "
98 I IBRTN'="" W:+EVDT !,?20 W "for ",$S(BT>2:"Outpatient ",BT>0:"Inpatient ",1:""),IBRTN
99 I $G(IBBN)'="" W !!,?7,"Therefore, charges can not be calculated for this bill (",IBBN,") "
100 W !
101 Q
102 ;
103WAIT N DIR,DIRUT,DUOUT,DTOUT,Y,X S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
104 Q
105 ;
106HELP(IBIFN) ; display rs/cs for the bill - used as help text
107 N IBX I +$G(IBIFN) S IBX=$$DISPLAY(IBIFN)
108 Q
Note: See TracBrowser for help on using the repository browser.