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

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

initial load of WorldVistAEHR

File size: 8.4 KB
Line 
1IBCNBLA ;ALB/ARH - Ins Buffer: LM action calls ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82,149,153,184,271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5NEWSCRN(TEMPLAT,TMPARR,IBBUFDA) ; open a new screen for a specific buffer entry, pass in LM template and the array to select from
6 ; if temp array is defined then user selects the buffer entry, otherwise use entry passed in
7 ;
8 I $G(TMPARR)'="" N IBBUFDA S IBBUFDA=$$SEL(TMPARR)
9 I +$G(IBBUFDA),$G(TEMPLAT)'="",+$$LOCK^IBCNBU1(IBBUFDA,1) D EN^VALM(TEMPLAT) D UNLOCK^IBCNBU1(IBBUFDA)
10 S VALMBCK="R"
11 Q
12 ;
13SEL(TMPARR) ; user selects one of the items from the list on the screen
14 ;
15 N VALMY,IBX,IBY,IBSELN S IBX=""
16 I $G(TMPARR)'="",'$O(^TMP(TMPARR,$J,0)) D G SELQ
17 . W !!,"There are no '",$S($G(VALM("ENTITY"))'="":VALM("ENTITY"),1:"record"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR
18 ;
19 D EN^VALM2($G(XQORNOD(0)),"OS")
20 I $D(VALMY),$G(TMPARR)'="" S IBSELN=0 F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D
21 . S IBX=$P($G(^TMP(TMPARR,$J,IBSELN)),U,2,99)
22 . ;
23 . I TMPARR="IBCNBLLX" S IBY=$P($G(^IBA(355.33,+IBX,0)),U,4) I IBY'="E" D S IBX=""
24 .. W !!," >>> Selected entry has been ",$S(IBY="A":"ACCEPTED",IBY="R":"REJECTED",1:"UNKNOWN STATUS")
25 .. W " and may no longer be edited or modified.",! S DIR(0)="E" D ^DIR K DIR
26 ;
27SELQ Q IBX
28 ;
29PNXTSCRN(TEMPLAT,IBBUFDA) ; open a new screen for a buffer entry, rebuild the process screen on return since it may have changed
30 D NEWSCRN^IBCNBLA(TEMPLAT,"",IBBUFDA)
31 D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R"
32 Q
33 ;
34LNXTSCRN(TEMPLAT,TMPARR) ; select entries from list to process/expand
35 ;
36 ; This procedure is called from the ListMan action protocols for
37 ; processing and expanding buffer entries.
38 ; TEMPLAT - list template name for associated action
39 ; TMPARR - subscript in scratch global
40 ;
41 NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
42 NEW ACT,REMAIN,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
43 D FULL^VALM1
44 D MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
45 I '$D(IBCNEZAR) G LNXTX
46 ;
47 ; loop through the list of selected buffer entries
48 S IBCNEZEN=0,IBCNEZCT=0
49 F S IBCNEZEN=$O(IBCNEZAR(IBCNEZEN)) Q:'IBCNEZEN D
50 . I 'IBCNEZAR(IBCNEZEN) Q ; user could not get this one
51 . S IBCNEZBF=$P(IBCNEZAR(IBCNEZEN),U,3) ; buffer ien
52 . S IBBUFDA=IBCNEZBF ; just in case IB rtns need this
53 . S IBCNEZCT=IBCNEZCT+1
54 . I '$D(IBCNEZQ) D
55 .. D EN^VALM(TEMPLAT) ; invoke list template
56 .. I $G(IBFASTXT) S IBCNEZQ=1 Q ; Fast Exit processing
57 .. S ACT="expand"
58 .. I TEMPLAT["PROCESS" S ACT="process"
59 .. S REMAIN=IBCNEZGD-IBCNEZCT
60 .. I 'REMAIN Q
61 .. W @IOF
62 .. W !!!,"You are ",ACT,"ing multiple insurance buffer entries."
63 .. W !,"You just completed entry number ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,")."
64 .. S DIR(0)="Y"
65 .. S DIR("A")="Do you want to "_ACT_" the remaining entry"
66 .. I REMAIN>1 S DIR("A")="Do you want to "_ACT_" the remaining "_REMAIN_" entries"
67 .. S DIR("B")="YES"
68 .. W ! D ^DIR K DIR
69 .. I 'Y S IBCNEZQ=1 ; User said NO so set the Quitting variable
70 .. Q
71 . ;
72 . ; Make sure to unlock the buffer entry in all cases when finished,
73 . ; even if the user wants to quit out of this loop
74 . D UNLOCK^IBCNBU1(IBCNEZBF)
75 . Q
76LNXTX ;
77 S VALMBCK="R"
78 Q
79 ;
80LREJECT(TMPARR) ; user select entries from list then reject/delete them
81 ;
82 ; This procedure is called from the ListMan action protocol for
83 ; rejecting buffer entries.
84 ; TMPARR - subscript in scratch global
85 ;
86 NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
87 D FULL^VALM1
88 D MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
89 I '$D(IBCNEZAR) G LREJX
90 ;
91 ; loop through the list of selected buffer entries
92 S IBCNEZEN=0,IBCNEZCT=0
93 F S IBCNEZEN=$O(IBCNEZAR(IBCNEZEN)) Q:'IBCNEZEN D
94 . I 'IBCNEZAR(IBCNEZEN) Q ; user could not get this one
95 . S IBCNEZBF=$P(IBCNEZAR(IBCNEZEN),U,3)
96 . S IBBUFDA=IBCNEZBF ; just in case IB rtns need this
97 . S IBCNEZCT=IBCNEZCT+1
98 . I '$D(IBCNEZQ) D
99 .. W @IOF,!?2,$G(IORVON)
100 .. W " Entry ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,") "
101 .. W $G(IORVOFF)
102 .. D REJECT^IBCNBLA1(IBCNEZBF,.IBCNEZQ)
103 .. ;
104 .. ; If the user wants to stop and we're not processing the last one,
105 .. ; then determine if we should process the remaining entries
106 .. ;
107 .. I $D(IBCNEZQ),IBCNEZCT<IBCNEZGD D
108 ... NEW REMAIN,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
109 ... S REMAIN=IBCNEZGD-IBCNEZCT
110 ... S DIR(0)="Y"
111 ... S DIR("A")="Do you want to process the remaining entry"
112 ... I REMAIN>1 S DIR("A")="Do you want to process the remaining "_REMAIN_" entries"
113 ... S DIR("B")="NO"
114 ... W ! D ^DIR K DIR
115 ... ; if user wants to continue, then kill the quitting variable
116 ... I Y KILL IBCNEZQ
117 ... Q
118 .. Q
119 . ;
120 . ; Make sure to unlock the buffer entry in all cases when finished,
121 . ; even if the user wants to quit out of this loop
122 . D UNLOCK^IBCNBU1(IBCNEZBF)
123 . Q
124LREJX ;
125 S VALMBCK="R"
126 Q
127 ;
128 ;
129FASTEXIT ; sets flag signaling system should be exited
130 N DIR,DIRUT,X,Y
131 S VALMBCK="Q"
132 D FULL^VALM1
133 S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
134 I +Y S IBFASTXT=1
135 Q
136 ;
137SELSORT ; select the way to sort the list screen
138 N DIR,DIRUT,X,Y,DTOUT,DUOUT,DIROUT,ST,STDES
139 ;
140 D FULL^VALM1 W !
141 W !,"Select the item to sort the buffer records on the buffer list screen."
142 S DIR(0)="SO^1:Patient Name;2:Insurance Company;3:Source of Information;4:Date Entered;5:Inpatients;6:Means Test;7:On Hold;8:Verified;9:IIV Status"
143 S DIR("A")="Sort the list by",DIR("B")=$P($G(IBCNSORT),"^",2)
144 D ^DIR K DIR
145 I 'Y G SELSORTX
146 S IBCNSORT=Y_"^"_Y(0)
147 ;
148 ; ESG - 6/7/02 - SDD 5.1.1
149 ; If the user wants to sort by symbol, then ask them which
150 ; symbol should appear first and process accordingly.
151 ;
152 KILL IBCNSORT(1) ; initialize the symbol sort array
153 I +IBCNSORT=9 D I $D(DIRUT)!('Y) G SELSORTX
154 . ;
155 . ; build the array of default sort order
156 . S IBCNSORT(1,"+")=10
157 . S IBCNSORT(1,"-")=20
158 . S IBCNSORT(1,"#")=25 ; Added pound to sort criteria
159 . S IBCNSORT(1,"!")=30
160 . S IBCNSORT(1," ")=40
161 . S IBCNSORT(1,"?")=50
162 . S IBCNSORT(1,"*")=60
163 . ;
164 . ; build the DIR array to ask the question
165 . S DIR(0)="SO^"
166 . F ST="1:+'A1","2:-'D1","3:#'U1","4:!'B1","5: '","6:?'Q1" D ; removed blanks ; replaced tilde w/apostrophe and added pound as option 3
167 .. I ST="5: '" S STDES="No Problems Identified, Awaiting Electronic Processing" ; removed blanks
168 .. E S STDES=$$GET1^DIQ(365.15,$$FIND1^DIC(365.15,"","X",$P(ST,"'",2)),.01,"E")
169 .. S DIR(0)=DIR(0)_$P(ST,"'")_" "_STDES_$S(ST="6:?'Q1":"",1:";")
170 . S DIR("A")="Which IIV Status do you want to appear first?"
171 . S DIR("B")=1
172 . S DIR("?",1)=" Please identify the IIV status that you want to appear first in the Insurance"
173 . S DIR("?",2)=" Buffer listing. The symbol appears immediately to the left of the patient"
174 . S DIR("?",3)=" name in the list. The default sort order for statuses is the same as"
175 . S DIR("?",4)=" they are presented in this list below. You may choose which status will appear"
176 . S DIR("?",5)=" first in the list. The remaining statuses will be sorted according to this"
177 . S DIR("?",6)=" default sort order. When sorting by IIV status, the secondary sort"
178 . S DIR("?",7)=" is the entered date and the final sort is by patient name."
179 . S DIR("?")=" "
180 . D ^DIR K DIR
181 . I $D(DIRUT) Q
182 . I 'Y Q
183 . ;
184 . ; update the sort order array with the chosen symbol
185 . S IBCNSORT(1,$E(Y(0)))=1
186 . S $P(IBCNSORT,U,3)=$E(Y(0))
187 . Q
188 ;
189 ; rebuild and resort the list and update the list header
190 D INIT^IBCNBLL,HDR^IBCNBLL
191 ;
192SELSORTX ;
193 S VALMBCK="R",VALMBG=1
194 Q
195 ;
196TGLSCRN(IBBUFDA) ; toggle process screen from policy to insurance info, glbal variable IBCNSCRN contains ins co chosen
197 Q:'$G(IBBUFDA)
198 D FULL^VALM1
199 W !!,"Enter an Insurance Company to display the Groups/Plans for that company or ",!,"enter Return to display a patient's policies.",!!
200 S IBCNSCRN=+$$SELINS^IBCNBU1
201 ;
202 D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R",VALMBG=1
203 Q
204 ;
205AMCHK ; This procedure is called from the main buffer screen as an action
206 ; to check the insurance company names in the buffer file. This will
207 ; invoke another ListMan screen that shows a list of all insurance
208 ; company names that do not exist in File 36 either as names or as
209 ; synonyms and also they do not exist in the Auto Match file. These
210 ; are bad insurance company names that need to be corrected before
211 ; electronic insurance verification attempts can be made.
212 ; esg - 6/20/02 - SDD 5.1.11 - Add an action on the main buffer
213 ; screen to call the buffer names check option
214 ;
215 D EN^IBCNEAMC
216 S VALMBCK="R"
217AMCHKX ;
218 Q
219 ;
Note: See TracBrowser for help on using the repository browser.