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

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

initial load of WorldVistAEHR
File size: 8.6 KB
Line 
1IBCNBLA1 ;ALB/ARH - Ins Buffer: LM action calls (cont) ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82,133,149,184,252,271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ADDBUF ; add a new buffer entry protocol
6 N DIC,DIR,DIRUT,DUOUT,X,Y,IBIN,DFN,IBBUFDA,IBDATA,AMLIST,IBHELP
7 D FULL^VALM1 S VALMBCK="R"
8 ;
9 ; Patient lookup
10 S DIC(0)="AEQM",DIC="^DPT(" D ^DIC Q:Y'>0 S DFN=+Y W !
11 ;
12INS ; Insurance company lookup
13 S DIR("A")="Insurance Company",DIR(0)="FO^1:30"
14 S DIR("?",1)="Please enter the name of the insurance company that provides coverage for this"
15 S DIR("?",2)="patient. This response is a free text response, however, a partial insurance"
16 S DIR("?")="company name look-up is available here."
17 ; BHS - 10/15/03 - Removed quit condition when user enters a caret
18 ; during the insurance lister and only sets IBIN
19 ; when a valid selection is made
20 D ^DIR K DIR Q:$D(DIRUT) S IBIN=Y,Y=$$DICINS^IBCNBU1(Y,1,10) I Y'<0,Y'=0 S IBIN=Y
21 ;
22 ; ESG - 6/17/02 - Usage of Auto Match file when adding a buffer entry
23 ; - SDD 5.1.3
24 ;
25 ; BHS - 10/15/03 - Added condition to allow Auto Match lookup when user
26 ; entered a caret during the insurance lister
27 I Y=0!(Y<0),$$AMLOOK^IBCNEUT1(IBIN,1,.AMLIST) S Y=$$AMSEL^IBCNEUT1(.AMLIST) I Y'<0,Y'=0 S IBIN=Y
28 I '$$INPTTR(355.33,20.01,$$UP^XLFSTR(IBIN)) D G INS
29 . D FIELD^DID(355.33,20.01,"","HELP-PROMPT","IBHELP")
30 . W !?5,IBHELP("HELP-PROMPT") Q
31 ;
32 S DIR(0)="Y",DIR("A")="Add a new Insurance Buffer entry for this patient and company",DIR("B")="YES" W ! D ^DIR K DIR Q:Y'=1
33 ;
34 S IBDATA(20.01)=$$UP^XLFSTR(IBIN),IBDATA(60.01)=DFN
35 S IBBUFDA=+$$ADDSTF^IBCNBES(1,DFN,.IBDATA) K IBDATA Q:'IBBUFDA
36 ;
37 I '$$LOCK^IBCNBU1(IBBUFDA,1) Q
38 D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
39 D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
40 D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
41 D BUFF^IBCNEUT2(IBBUFDA,+$$INSERROR^IBCNEUT3("B",IBBUFDA)) ; symbol
42 D UNLOCK^IBCNBU1(IBBUFDA)
43 ;
44 D INIT^IBCNBLL,HDR^IBCNBLL S VALMBCK="R"
45 Q
46 ;
47INSEDIT(IBBUFDA) ; edit the Insurance data of a buffer entry
48 ;
49 Q:'$G(IBBUFDA) D FULL^VALM1
50 D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
51 ;
52 D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
53 Q
54 ;
55GRPEDIT(IBBUFDA) ; edit the Group/Plan data of a buffer entry
56 ;
57 Q:'$G(IBBUFDA) D FULL^VALM1
58 D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
59 ;
60 D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R"
61 Q
62 ;
63POLEDIT(IBBUFDA) ; edit the Subscriber Policy data of a buffer entry
64 ;
65 Q:'$G(IBBUFDA) D FULL^VALM1
66 D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
67 ;
68 D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
69 Q
70 ;
71ALLEDIT(IBBUFDA) ; edit All data of a buffer entry
72 ;
73 Q:'$G(IBBUFDA) D FULL^VALM1
74 D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
75 D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
76 D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
77 ;
78 D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
79 Q
80 ;
81CMPEDIT(IBBUFDA) ; display a buffer entry and an existing ins entry for comparison, allow edit of buffer data
82 Q:'$G(IBBUFDA)
83 N IBDA,IBPOLDA,IBGRPDA,IBINSDA,DIR,DIRUT,X,Y
84 ;
85 D FULL^VALM1
86 ;
87 S IBDA=$$SEL^IBCNBLA("IBCNBLPX") I 'IBDA G CMPQ
88 I $P(IBDA,U,4)'="",+$G(^IBA(355.33,+IBBUFDA,60))'=$P(IBDA,U,4) W !,"Buffer Patient doesn't match Policy Patient, can't continue." G CMPQ
89 S IBINSDA=+IBDA,IBGRPDA=+$P(IBDA,U,2),IBPOLDA=+$P(IBDA,U,3)
90 ;
91CEINS W @IOF
92 I 'IBINSDA W !,"No Insurance Company Selected for Comparison."
93 W ! D INS^IBCNBCD(IBBUFDA,IBINSDA)
94 S DIR("?")="The Buffer entry's Insurance Company data may be edited or Return advances the display to the Group/Plan data.",DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,INS^IBCNBCD("_IBBUFDA_","_IBINSDA_")"
95 W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
96 D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
97 I Y'="","EEee"[Y D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA) G CEINS
98 ;
99CEGRP W @IOF
100 I 'IBGRPDA W !,"No Insurance Group/Plan Selected for Comparison."
101 I +IBGRPDA W !,?14,"Patient is "_$S(+IBPOLDA:"",1:"NOT ")_"a member of this Insurance Group/Plan",!
102 W ! D GRP^IBCNBCD(IBBUFDA,IBGRPDA)
103 S DIR("?")="The Buffer entry's Group/Plan data may be edited or Return advances the display to the Patient Policy data.",DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,GRP^IBCNBCD("_IBBUFDA_","_IBGRPDA_")"
104 W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
105 D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
106 I Y'="","EEee"[Y D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA) G CEGRP
107 ;
108CEPOL W @IOF
109 I 'IBPOLDA W !,"No Patient Policy Selected for Comparison."
110 W ! D POLICY^IBCNBCD(IBBUFDA,IBPOLDA)
111 S DIR("?")="The Buffer entry's Patient Policy data may be edited or return to the screen display.",DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,POLICY^IBCNBCD("_IBBUFDA_","_IBPOLDA_")"
112 W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
113 D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
114 I Y'="","EEee"[Y D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA) G CEPOL
115 ;
116CMPQ D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
117 Q
118 ;
119VERIFY(IBBUFDA) ; verify a buffer entry
120 ;
121 N DIR,DIRUT,X,Y,IBX,IBY Q:'$G(IBBUFDA)
122 D FULL^VALM1 S VALMBCK="R"
123 W ! D DISPBUF^IBCNBU1(IBBUFDA)
124 ;
125 S IBX=$G(^IBA(355.33,IBBUFDA,0)),IBY="" I +$P(IBX,U,10) S IBY="Re-" W !!,"This entry already verified by ",$$EXPAND^IBTRE(355.33,.11,$P(IBX,U,11))," on ",$$FMTE^XLFDT($P(IBX,U,10)),"."
126 ;
127 S DIR("?")="Enter Yes if the coverage and information in this Buffer entry has been verified to be accurate." W !!
128 S DIR(0)="YO",DIR("B")="N",DIR("A")=IBY_"Verify the coverage in this buffer entry"
129 D ^DIR
130 I Y=1 D
131 . ; WCW - 04/11/2003 Clear out IIV Status when manually verified
132 . D CLEAR^IBCNEUT4(IBBUFDA,.IIVERR,1) K IIVERR
133 . K IBX S IBX(.1)="NOW",IBX(.11)=DUZ D EDITSTF^IBCNBES(IBBUFDA,.IBX)
134 . D INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED") W " Coverage Verified ..." H 2
135 ;
136 Q
137 ;
138REJECT(IBBUFDA,DIRUT) ; process a reject and then delete a buffer entry
139 ; Output parameter DIRUT is optional and passed in by reference. This
140 ; variable will be defined if the user enters a leading up-arrow,
141 ; times out, or enters a null response. This is so the calling routine
142 ; can detect if the user did something other than say Yes or No to
143 ; this question.
144 ;
145 N DIR,X,Y,IBX Q:'$G(IBBUFDA)
146 D FULL^VALM1 S VALMBCK="R"
147 W ! D DISPBUF^IBCNBU1(IBBUFDA)
148 W !!,"This action will delete all insurance and patient specific data from a buffer ",!,"entry without first saving that data to the insurance files, leaving a stub ",!,"entry for reporting purposes.",!
149 ;
150 S IBX=$G(^IBA(355.33,IBBUFDA,0)) I +$P(IBX,U,10) W !!,"This entry has been verified by ",$$EXPAND^IBTRE(355.33,.11,$P(IBX,U,11))," on ",$$FMTE^XLFDT($P(IBX,U,10)),".",!!
151 ;
152 S DIR("?")="Enter Yes to delete this buffer entry without saving any of it's data to the Insurance files."
153 S DIR(0)="YO",DIR("B")="N",DIR("A")="Reject this buffer entry (delete without saving to Insurance files)"
154 D ^DIR
155 I $D(DIRUT) G REJX
156 I Y=1 D REJECT^IBCNBAR(IBBUFDA) S VALMBCK="Q" D UPDLN^IBCNBLL(IBBUFDA,"REJECTED")
157REJX ;
158 Q
159 ;
160ACCEPT(IBBUFDA) ; process a buffer entry for acceptance
161 ;
162 Q:'$G(IBBUFDA)
163 N IBDA,IBINSDA,IBGRPDA,IBPOLDA,IBACCEPT S IBACCEPT=0
164 ;
165 D FULL^VALM1
166 ;
167 S IBDA=$$SEL^IBCNBLA("IBCNBLPX")
168 I $P(IBDA,U,4)'="",+$G(^IBA(355.33,+IBBUFDA,60))'=$P(IBDA,U,4) W !,"Buffer Patient doesn't match Policy Patient, can't continue." G ACCPTQ
169 I +$P(IBDA,U,3),'$P(IBDA,U,2) W !!,"Error: the selected policy has no associated plan. Can not continue." D WAIT^IBCNBUH G ACCPTQ
170 ;
171 S IBINSDA=+IBDA,IBGRPDA=+$P(IBDA,U,2),IBPOLDA=+$P(IBDA,U,3)
172 S:'IBINSDA (IBGRPDA,IBPOLDA)=0 S:'IBGRPDA IBPOLDA=0
173 ;
174 I 'IBINSDA,'$D(^XUSEC("IB INSURANCE COMPANY ADD",DUZ)) D G ACCPTQ
175 . W !!,"Sorry, but you do not have the required privileges to add",!,"new Insurance Companies."
176 . D WAIT^IBCNBUH
177 ;
178 S IBACCEPT=$$ACCEPT^IBCNBAA(IBBUFDA,IBINSDA,IBGRPDA,IBPOLDA)
179 ;
180ACCPTQ S VALMBCK="R" I +IBACCEPT S VALMBCK="Q" D UPDLN^IBCNBLL(IBBUFDA,"ACCEPTED")
181 Q
182 ;
183RESP(BUFF) ; List Response Report for Trace # associated with this entry
184 ; BUFF = buffer IEN
185 N NG,IBRSP,IBSTR,IBTRC,STOP,IBCNERTN,POP,IBCNESPC
186 ; Reset to Full Screen Mode
187 D FULL^VALM1
188 S NG=0
189 I $G(BUFF)="" S NG=1
190 I 'NG S IBRSP=$O(^IBCN(365,"AF",BUFF,"")) I IBRSP="" S NG=1
191 I 'NG S IBSTR=$G(^IBCN(365,IBRSP,0)),IBTRC=$P(IBSTR,U,9) I IBTRC="" S NG=1
192 I NG W !!,"This entry does not have an associated IIV response." D PAUSE^VALM1 G RESPX
193 S STOP=0,IBCNERTN="IBCNERP1",IBCNESPC("TRCN")=IBTRC_U_IBRSP
194 D R100^IBCNERP1
195RESPX S VALMBCK="R"
196 Q
197INPTTR(FILE,FLD,X) ; Does value X pass input transform for file, field?
198 N XCUTE
199 S XCUTE=$$GET1^DID(FILE,FLD,,"INPUT TRANSFORM")
200 X XCUTE
201 Q $D(X)
Note: See TracBrowser for help on using the repository browser.