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

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1IBCRLA1 ;ALB/ARH - RATES: DISPLAY ACTION PROTOCOLS ; 16-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,106**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6 ; the IBCRLxX1 level of TMP array shows where specific types of data begins display (like RT=RI)
7 ; this is used to begin redisplay of the screen at the section of data edited by the user (VALMBG)
8 ;
9EDRS ; -- IBCR RATE SCHEDULE EDIT action
10 N VALMQUIT,IBRSFNX,IBBR,IBBT,IBX,IBY S IBRSFNX=0
11 D FULL^VALM1
12 D EDITRS^IBCREE
13 K ^TMP("IBCRLS",$J),^TMP("IBCRLSX1",$J) D CLEAN^VALM10
14 D BLD^IBCRLS,HDR^IBCRLS
15 S IBX=$G(^IBE(363,+$G(IBRSFNX),0)),IBY=+$G(^TMP("IBCRLSX1",$J,+$P(IBX,U,2),+$P(IBX,U,3)))
16 S VALMBCK="R" I +IBY S VALMBG=+IBY
17 Q
18 ;
19EDRT ; -- IBCR RATE TYPE EDIT action
20 N VALMQUIT,IBRTFNX,IBY S IBRTFNX=0
21 D FULL^VALM1
22 D EDITRT^IBCREE
23 K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J) D CLEAN^VALM10
24 D BLD^IBCRLT S IBY=+$G(^TMP("IBCRLTX1",$J,+$G(IBRTFNX)))
25 S VALMBCK="R" I +IBY S VALMBG=+IBY
26 Q
27 ;
28EDBR ; -- IBCR BILLING RATE EDIT action
29 N VALMQUIT
30 D FULL^VALM1
31 D EDITBR^IBCREE
32 K ^TMP("IBCRLR",$J)
33 D BLD^IBCRLR
34 S VALMBCK="R"
35 Q
36 ;
37EDRG ; -- IBCR BILLING REGION EDIT action
38 N VALMQUIT,IBY
39 D FULL^VALM1
40 D EDITRG^IBCREE
41 K ^TMP("IBCRLG",$J)
42 D BLD^IBCRLG
43 S VALMBCK="R"
44 Q
45 ;
46EDCS ; -- IBCR CHARGE SET EDIT action
47 N VALMQUIT,IBCSFNX,IBX,IBY S IBCSFNX=0
48 D FULL^VALM1
49 D EDITCS^IBCREE
50 K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J) D CLEAN^VALM10
51 D BLD^IBCRLC
52 S IBX=$G(^IBE(363.1,$G(IBCSFNX),0)),IBY=+$G(^TMP("IBCRLCX1",$J,+$P(IBX,U,2)))
53 S VALMBCK="R" I +IBY S VALMBG=+IBY
54 Q
55 ;
56EDBI ; -- IBCR BILLING ITEM EDIT action
57 N VALMQUIT
58 D FULL^VALM1
59 D EDITBI^IBCREE
60 S VALMBCK="R"
61 Q
62 ;
63EDCI ; -- IBCR CHARGE ITEM EDIT action: (screen variables are updated durinig edit)
64 N VALMQUIT
65 D FULL^VALM1
66 D EDITCI^IBCREE1
67 K ^TMP("IBCRLI",$J)
68 D BLD^IBCRLI,HDR^IBCRLI
69 S VALMBCK="R"
70 Q
71 ;
72ENCI ; -- IBCR CHARGE ITEM SCREEN action: (get Charge Set then open Charge Item screen for Set)
73 N VALMQUIT,IBCSFN
74 D FULL^VALM1
75 S IBCSFN=$$GETCS^IBCRU1 I +IBCSFN>0 I $$GET^IBCRLI'<0 D EN^IBCRLI
76 S VALMBCK="R"
77 Q
78 ;
79CICITM ; -- IBCR CHARGE ITEM CHANGE action: (user select of specific items to display on CI screen)
80 N VALMQUIT,IBITEMX I '$G(IBCSFN) Q
81 S (IBSRNITM,IBITEMX)=$G(IBSRNITM)
82 D FULL^VALM1
83 S IBITEMX=$$GETITEM^IBCRU1(IBCSFN,"",1) I +IBITEMX S IBSRNITM=IBITEMX
84 K ^TMP("IBCRLI",$J)
85 D BLD^IBCRLI,HDR^IBCRLI
86 S VALMBCK="R",VALMBG=1
87 Q
88 ;
89CICDTS ; -- IBCR CHARGE ITEM DATES action: (user select of date range to display on CI screen)
90 N VALMQUIT,IBX I '$G(IBCSFN) Q
91 S IBSRNBDT=+$G(IBSRNBDT),IBSRNEDT=+$G(IBSRNEDT)
92 D FULL^VALM1
93 S IBX=$$GETDT^IBCRU1(IBSRNBDT,"Charges Effective on Date") I IBX?7N S (IBSRNBDT,IBSRNEDT)=+IBX
94 S IBX=$$GETDT^IBCRU1(IBSRNEDT,"Charges Effective to Date") I IBX?7N S IBSRNEDT=+IBX
95 K ^TMP("IBCRLI",$J)
96 D BLD^IBCRLI,HDR^IBCRLI
97 S VALMBCK="R",VALMBG=1
98 Q
99 ;
100FASTEXIT ; -- IBCR EXIT action: (sets flag signaling if user wants to sxit completely)
101 S VALMBCK="Q"
102 D FULL^VALM1
103 K DIR S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
104 I $D(DIRUT)!(Y) S IBFASTXT=5
105 K DIR,DIRUT
106 Q
107 ;
108MAINSCR ; -- IBCR MAIN SCREEN action: (sets flag signaling to return to main screen (INTRODUCTION))
109 S VALMBCK="Q"
110 D FULL^VALM1
111 S IBFASTXT=4
112 K DIR,DIRUT
113 Q
114 ;
115EDSG ; -- IBCR SPECIAL GROUPS EDIT action
116 N VALMQUIT,IBY
117 D FULL^VALM1
118 D EDITSG^IBCREE2
119 K ^TMP("IBCRLL",$J) D CLEAN^VALM10
120 D BLD^IBCRLL
121 S VALMBCK="R"
122 Q
123 ;
124EDRL ; -- IBCR REVENUE CODE LINK EDIT action
125 N VALMQUIT,IBY
126 D FULL^VALM1
127 D EDITRL^IBCREE2
128 K ^TMP("IBCRLM",$J)
129 D BLD^IBCRLM,HDR^IBCRLM
130 S VALMBCK="R"
131 Q
132 ;
133ENRL ; -- IBCR REVENUE CODE LINK SCREEN action: (get Billing Rate/Special Group and CPT then open Rv links screen )
134 N VALMQUIT,IBSGFN,IBBRFN,IBCPT
135 D FULL^VALM1
136 W !!,"Select CPT to display.",!! S IBCPT=$$GETCPT^IBCRU1("",1) I IBCPT>0 D EN^IBCRLM
137 S VALMBCK="R"
138 Q
139 ;
140RLCLNK ; -- IBCR REVENUE CODE LINK CHANGE action: (user select CPT to display rev code links on screen)
141 N VALMQUIT,IBITEMX
142 D FULL^VALM1
143 S IBITEMX=$$GETCPT^IBCRU1("",1) I +IBITEMX>0 S IBCPT=IBITEMX
144 K ^TMP("IBCRLM",$J)
145 D BLD^IBCRLM,HDR^IBCRLM
146 S VALMBCK="R",VALMBG=1
147 Q
148 ;
149EDPD ; -- IBCR PROVIDER DISCOUNT EDIT action
150 N VALMQUIT,IBPDFNX,IBX,IBY S IBPDFNX=0
151 D FULL^VALM1
152 D EDITPD^IBCREE2
153 K ^TMP("IBCRLN",$J),^TMP("IBCRLNX1",$J) D CLEAN^VALM10
154 D BLD^IBCRLN
155 S IBY=+$G(^TMP("IBCRLNX1",$J,+IBPDFNX))
156 S VALMBCK="R" I +IBY S VALMBG=+IBY
157 Q
158 ;
159ENPD ; -- IBCR PROVIDER DISCOUNT SCREEN action: (get Special Group then open screen )
160 N VALMQUIT,IBSGFN
161 D FULL^VALM1
162 S IBSGFN=$$GETSG^IBCRU1(2) I +IBSGFN>0 D EN^IBCRLN
163 S VALMBCK="R"
164 Q
Note: See TracBrowser for help on using the repository browser.