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

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

initial load of WorldVistAEHR

File size: 7.6 KB
Line 
1IBCEF61 ;ALB/TMP - EDI TRANSMISSION RULES DEFINITION ;28-APR-99
2 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
3 ;
4SELRULE(IBRULE) ; Select rule
5 D FULL^VALM1
6 S IBRULE=""
7 N IBR,IB
8 D EN^VALM2($G(XQORNOD(0)),"S")
9 S IBR=0 F S IBR=$O(VALMY(IBR)) Q:'IBR S IB=$G(^TMP("IBCE-RULEDX",$J,IBR)),IBRULE=+$P(IB,U,2)
10 Q
11 ;
12ACTIVE(IBRULE) ; Edit rules' active/inactive dates
13 ; IBRULE = ien of rule in file 364.4
14 ;
15 G:'$G(IBRULE) ACTQ
16 N DA,DR,DIE,X,Y,Z,Z0
17 S DA=$G(IBRULE),DIE="^IBE(364.4,"
18 S DR=".02;.06"
19 D ^DIE
20 I $D(Y) S IBRULE=0 G ACTQ
21 D REBLD^IBCEF6($G(IBACTIVE))
22ACTQ S VALMBCK="R"
23 Q
24 ;
25SCRACT ; Rebld display - only currently active
26 S IBACTIVE=1
27 D REBLD^IBCEF6(1)
28 S VALMBCK="R"
29 Q
30 ;
31NOSCR ; Rebld display - inactive and currently active
32 S IBACTIVE=0
33 D REBLD^IBCEF6(0)
34 S VALMBCK="R"
35 Q
36 ;
37BILTYP(IBRULE) ; Allow to edit bill types for rule
38 ; IBRULE = ien of rule - file 364.4
39 ;
40 G:'$G(IBRULE) BILTYPQ
41 N DA,DR,DIE,X,Y,Z,Z0,IBRT,IB,IBOK,IBCT
42 S DA=$G(IBRULE),DIE="^IBE(364.4,",IBRT=$P($G(^IBE(364.4,IBRULE,0)),U,11)
43 I $S(IBRT=9:0,1:IBRT'=1) D G BILTYPQ
44 . W !
45 . S DIR(0)="EA",DIR("A",1)="RULE TYPE '"_$$EXPAND^IBTRE(364.4,.11,IBRT)_"' DOES NOT ALLOW BILL TYPE RESTRICTIONS",DIR("A")="PRESS RETURN " D ^DIR K DIR W !
46 S (IBO,IBCT)=0 ;Extract existing entries
47 F S IBO=$O(^IBE(364.4,IBRULE,"BTYP",IBO)) Q:'IBO S IBX=$P($G(^(IBO,0)),U),IBO(IBX)=IBO_U_$P(^(0),U,2,3),IBCT=IBCT+1,IB(364.41,IBCT,.01)=IBX,IBI(IBX)=IBCT F Z=2,3 I $P(IBO(IBX),U,Z)'="" S IB(364.41,IBCT,Z/100)=$P(IBO(IBX),U,Z)
48 ; Display entries, allow to add/edit/delete
49 D EN^IBCEF62
50BILTYPQ S VALMBCK="R"
51 Q
52 ;
53SEL(VALMY) ; Select one or more bill type restriction entries
54 ; VALMY = passed by reference and returned subscripted by
55 ; entry #(s) in the LM array selected
56 ;
57 N Z
58 D FULL^VALM1
59 N IBR
60 D EN^VALM2($G(XQORNOD(0)))
61 Q
62 ;
63BTEDIT(IBRULE) ; Edit bill type restriction dates
64 ; IBRULE = ien of the bill type restriction being edited
65 ; (0)= ien of the RULE - file 364.4
66 G:'$G(IBRULE) BTEQ
67 ;
68 N DA,DIE,DR,Y,X,VALMY,Z,IBBT
69 ;
70 S IBCT=0
71 D SEL(.VALMY)
72 G:'$O(VALMY(0)) BTEQ ; None selected
73 ;
74 S Z=0 F S Z=$O(VALMY(Z)) Q:'Z S IBBT=+$G(^TMP("IBCE-BTDX",$J,Z)) I IBBT D
75 . S DA(1)=IBRULE,DA=IBBT,DIE="^IBE(364.4,"_DA(1)_",""BTYP"",",DR=".02;.03"
76 . W !!,"Bill Type Restriction #"_Z_" - "_$E($G(^TMP("IBCE-BT",$J,Z,0)),5,50),!
77 . D ^DIE
78 . D REBLD^IBCEF62
79 ;
80BTEQ S VALMBCK="R"
81 Q
82 ;
83BTADD(IBRULE) ; Add new bill type restrictions
84 ; IBRULE = ien of rule entry - file 364.4
85 N IB,IBCT,Z,IBOK
86 D FULL^VALM1
87 G:'$G(IBRULE) BTAQ
88 ;
89 S (IBCT,Z)=0
90 S Z=0 F S Z=$O(^IBE(364.4,IBRULE,"BTYP",Z)) Q:'Z S IBCT=IBCT+1,IB(364.41,IBCT,.01)=$P($G(^(Z,0)),U)
91 ;
92 D BTYP^IBCEF51(.IB,.IBOK,0)
93 ;
94 I IBOK D
95 . N Z
96 . S Z=0 F S Z=$O(^IBE(364.4,IBRULE,"BTYP",Z)) Q:'Z S DA=Z,DA(1)=IBRULE,DIK="^IBE(364.4,"_DA(1)_",""BTYP""," D ^DIK
97 . D ADDBTYP(.IB,IBRULE)
98 . D REBLD^IBCEF62
99 D SUCCESS(IBOK)
100 ;
101BTAQ S VALMBCK="R"
102 Q
103 ;
104INSCO(IBRULE) ; Allow user to edit rule's ins co data
105 ; IBRULE = ien of rule - file 364.4
106 ;
107 G:'$G(IBRULE) INSCOQ
108 N DA,DR,DIE,X,Y,Z,Z0,IB,IB0
109 S DA=$G(IBRULE),DIE="^IBE(364.4,"
110 S IB0=$G(^IBE(364.4,IBRULE,0)),IB(".07O")=$P(IB0,U,7)
111 S DR=$S($P(IB0,U,3)'=2:".07;S Y=$S(X=1:""@10"",X=2:""@20"",1:""@99"");",1:"")_"@10;3;S Y=""@99"";@20;2;S Y=""@99"";@99"
112 D ^DIE
113 S IB(.07)=$P($G(^IBE(364.4,IBRULE,0)),U,7)
114 ;
115 I IB(".07O"),IB(".07O")'=IB(.07),IB(".07O")'=3 D ; Delete 'old' includes/excludes
116 . S Z=$P("3^2",U,+IB(".07O")),Z0=0 F S Z0=$O(^IBE(364.4,IBRULE,Z,Z0)) Q:'Z0 S DA=Z0,DA(1)=IBRULE,DIK="^IBE(364.4,"_DA(1)_","_Z_"," D ^DIK
117 ;
118 ; If all ins cos selected, delete existing specific ones in/excluded
119 I 'IB(.07)!(IB(.07)=3) D
120 . Q:IB(".07O")=IB(.07)
121 . F Z=2,3 I $O(^IBE(364.4,IBRULE,Z,0)) S Z0=0 F S Z0=$O(^IBE(364.4,IBRULE,Z,Z0)) Q:'Z0 S DA=Z0,DA(1)=IBRULE,DIK="^IBE(364.4,"_DA(1)_","_Z_"," D ^DIK
122 E D
123 . Q:$O(^IBE(364.4,IBRULE,$S(IB(.07)=1:3,1:2),0))
124 . W !,"Warning ... no insurance companies chosen to "_$S(IB(.07)=1:"in",1:"ex")_"clude"
125 . D QUIT^IBCEF5
126 D REBLD^IBCEF6($G(IBACTIVE))
127 ;
128INSCOQ S VALMBCK="R"
129 Q
130 ;
131MISC(IBRULE) ; Edit other misc fields for the rule
132 ; IBRULE = ien of rule - file 364.4
133 ;
134 I $G(IBRULE) D
135 . N DA,DR,DIE,X,Y,Z,Z0
136 . S DA=$G(IBRULE),DIE="^IBE(364.4,"
137 . S DR=".08;1;4"
138 . D ^DIE
139 . D REBLD^IBCEF6($G(IBACTIVE))
140 S VALMBCK="R"
141 Q
142 ;
143DISPRUL(IBRULE) ; Display rule selected
144 ; IBRULE = ien of rule - file 364.4
145 ;
146 I '$G(IBRULE) D FULL^VALM1
147 N DIOBEG,FR,TO,BY,DIC,DA,L,FLDS,DHD
148 S (FR,TO)=$G(IBRULE),DHD="[IBCE RULE DISPLAY HEADER]"
149 S L=0,BY="@RULE NUMBER",DIC="^IBE(364.4,",FLDS="[IBCE RULE DISPLAY]"
150 S DIOBEG="W !"
151 W !!
152 D EN1^DIP
153DISPRQ S VALMBCK="R"
154 D PAUSE^VALM1
155 Q
156 ;
157SUCCESS(IBOK) ; Display msg after add rule
158 ; IBOK = 1 if successful, 0 if not
159 ;
160 N DIR,Y,X
161 S DIR(0)="EA"
162 W !
163 I $G(IBOK) S DIR("A",1)="TRANSMISSION RULE(s) HAVE BEEN SUCCESSFULLY FILED"
164 I '$G(IBOK) S DIR("A",1)="NO TRANSMISSION RULES ADDED"
165 S DIR("A")="PRESS RETURN " D ^DIR K DIR
166 S VALMBCK="R"
167 Q
168 ;
169ADDBTYP(IB,IBDA1) ; Add bill types in IB(364.41) to rule IBDA1
170 ;
171 N Z,Z0,IBC
172 I $D(IB(364.41)) D
173 . S IBC=0 F S IBC=$O(IB(364.41,IBC)) Q:'IBC D
174 .. N DO,DD,DIC,DLAYGO,DA,X,Y
175 .. S Z=.01 F S Z=$O(IB(364.41,IBC,Z)) Q:'Z S Z0=$G(IB(364.41,IBC,Z)) I Z0'="" D ;Bill type excepts
176 ... S DIC("DR")=$G(DIC("DR"))_$S($G(DIC("DR"))="":"",1:";")_Z_"///"_Z0
177 .. I '$D(^IBE(364.4,IBDA1,"BTYP",0)) S DIC("P")=$$GETSPEC^IBEFUNC(364.4,.1)
178 .. S X=IB(364.41,IBC,.01)
179 .. S DA(1)=IBDA1,DIC="^IBE(364.4,"_IBDA1_",""BTYP"",",DIC(0)="L",DLAYGO=364.4
180 .. D FILE^DICN
181 Q
182 ;
183INSADD(IB,IBDA1) ; Add ins co exceptions from entries in
184 ; IB(364.42 - exclude) or IB(364.43 - include) to rule IBDA1
185 ;
186 N Z,IBNODE,Z0
187 F Z=364.42,364.43 S IBNODE=$E(Z,$L(Z)),Z0=0 F S Z0=$O(IB(Z,Z0)) Q:'Z0 D
188 . N DO,DD,DIC,DLAYGO,DA
189 . I '$D(^IBE(364.4,IBDA1,IBNODE,0)) S DIC("P")=$$GETSPEC^IBEFUNC(364.4,IBNODE)
190 . S DA(1)=IBDA1,DIC="^IBE(364.4,"_IBDA1_","_IBNODE_",",DIC(0)="L",DLAYGO=364.4,X=Z0
191 . D FILE^DICN K DIC
192 Q
193 ;
194BTDTOK(IBRULE,IBBT,IBDTYP,X) ; Check bill type date is consistent for rule
195 ; IBRULE = ien of rule - file 364.4
196 ; IBBT = ien of bill type in rule IBRULE (optional if check at top level)
197 ; IBDTYP = 1 for active date check, 2 for inactive date check
198 ; X = Value of date being validated
199 ;
200 ; Function returns 1 if consistencies are OK, 0 if not
201 ;
202 N IBOK,IBPCK,Z
203 S IBOK=1
204 S IBPCK=$S(IBDTYP=1:2,1:6)
205 ;
206 ; Check for consistency at rule level first
207 ;
208 ; Active dt must not be after rule's inact dt
209 I IBDTYP=1,$P($G(^IBE(364.4,IBRULE,0)),U,6),X>$P(^(0),U,6) S Z=$$FMTE^XLFDT($P($G(^IBE(364.4,IBRULE,0)),U,6)) D EN^DDIOL("CANNOT BE AFTER RULE'S INACTIVE DATE OF "_$S('Z:"<MISSING>",1:Z),,"!!") S IBOK=0 G BTDTQ
210 ;
211 ; Inact dt must not be prior to rule's active dt
212 I IBDTYP=2,$S('$P($G(^IBE(364.4,IBRULE,0)),U,2):'$G(IBBT),1:X<$P($G(^(0)),U,2)) S Z=$$FMTE^XLFDT($P($G(^IBE(364.4,IBRULE,0)),U,2)) D EN^DDIOL("CANNOT BE BEFORE RULE'S ACTIVE DATE OF "_$S('Z:"<MISSING>",1:Z),,"!!") S IBOK=0 G BTDTQ
213 ;
214 I $G(IBBT) D ; Check for consistency at the bill type level
215 . ; Active dt at bt level must be prior to inactive dt
216 . I IBDTYP=1,$P($G(^IBE(364.4,IBRULE,"IBTYP",IBBT,0)),U,3),X>$P(^(0),U,3) S Z=$$FMTE^XLFDT($P(^IBE(364.4,IBRULE,"IBTYP",IBBT,0),U,3)) D EN^DDIOL("MUST BE PRIOR TO BILL TYPE'S INACTIVE DATE OF "_$S('Z:"<MISSING>",1:Z),,"!!") S IBOK=0 Q
217 . ; Inactive dt at bt level must be after active dt
218 . I IBDTYP=2,$S('$P($G(^IBE(364.4,IBRULE,"IBTYP",IBBT,0)),U,2):1,1:X<$P(^(0),U,2)) S Z=$$FMTE^XLFDT($P($G(^IBE(364.4,IBRULE,"IBTYP",IBBT,0)),U,2)) D EN^DDIOL("MUST BE AFTER BILL TYPE'S ACTIVE DATE OF "_$S('Z:"<MISSING>",1:Z),,"!!") S IBOK=0 Q
219 . ;
220 . S Z=0
221 . F S Z=$O(^IBE(364.4,IBRULE,"BTYP",Z)) Q:'Z S Z0=$G(^(Z,0)) D Q:'IBOK
222 .. I $P(Z0,U,IBDTYP+1),$S(IBDTYP=1:X<$P(Z0,U,2),1:X>$P(Z0,U,3)) D EN^DDIOL("CHANGE WOULD INVALIDATE BILL TYPE RESTRICTION DATE",,"!!") S IBOK=0
223BTDTQ Q IBOK
224 ;
Note: See TracBrowser for help on using the repository browser.