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

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

initial load of WorldVistAEHR
File size: 8.4 KB
Line 
1IBCNBLL ;ALB/ARH - Ins Buffer: LM main screen, list buffer entries ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82,149,153,183,184,271,345**;21-MAR-94;Build 28
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; - main entry point for screen
6 D EN^VALM("IBCNB INSURANCE BUFFER LIST")
7 Q
8 ;
9HDR ; header code for list manager display
10 S VALMHDR(1)="Buffer File entries not yet processed."
11 S VALMHDR(1)=VALMHDR(1)_" (sorted by "_$P(IBCNSORT,U,2)
12 I $P(IBCNSORT,U,3)="" S VALMHDR(1)=VALMHDR(1)_")"
13 E S VALMHDR(1)=VALMHDR(1)_", """_$P(IBCNSORT,U,3)_""" first)"
14 Q
15 ;
16INIT ; initialization for list manager list
17 K ^TMP("IBCNBLL",$J),^TMP("IBCNBLLX",$J),^TMP("IBCNBLLY",$J),^TMP($J,"IBCNBLLS")
18 I '$G(IBCNSORT) S IBCNSORT="1^Patient Name"
19 D BLD
20 Q
21 ;
22HELP ; list manager help
23 D FULL^VALM1
24 W @IOF
25 W !,"This screen lists all Insurance plans and policies in the Insurance Buffer",!,"that have not yet been processed (accepted or rejected).",!
26 W !,"Flags displayed on screen if they apply to the Buffer entry:",!," i - Patient has other currently effective Insurance",!," I - Patient is currently admitted as an Inpatient"
27 W !," E - Patient has Expired",!," Y - Means Test Copay Patient",!," H - Patient has Bills On Hold",!," * - Buffer entry Verified by User"
28 ;
29 ; ESG - 6/7/02 - SDD 5.1.9
30 ; Help screen description of new symbols
31 ;
32 D PAUSE^VALM1
33 W !!,"IIV Electronic Insurance Verification Status"
34 W !," The following IIV Status indicators may appear to the left of the"
35 W !," patient name:"
36 W !," + - The IIV payer indicated that this is an active policy via"
37 W !," electronic inquiry/response."
38 W !," ? - IIV inquiry was sent; awaiting reply from Payer."
39 W !," # - IIV received an electronic response from the Payer, but was not able to"
40 W !," determine whether or not the Payer is indicating active coverage. "
41 W !," Carefully review the associated IIV Response Report, specifically "
42 W !," focusing on the Eligibility/Benefits section, if present."
43 W !," Manual confirmation is required."
44 W !," ! - IIV was unable to send an electronic inquiry for this insurance "
45 W !," information. User correction may be required to allow IIV to send "
46 W !," this inquiry."
47 W !," Please use the Expand Entry option to see more information."
48 W !," - - The IIV payer indicated that this is NOT an active policy via "
49 W !," electronic inquiry/response."
50 D PAUSE^VALM1
51 W !!,"When an entry is Processed it is either:"
52 W !,?3,"Accepted - the Buffer entry's data is stored in the main Insurance files.",!,?12,"- the modified Insurance entry is flagged as Verified.",!,?3,"Rejected - the Buffer entry's data is not stored in the main Insurance files."
53 W !!,"Once an entry is processed (either accepted or rejected) most of the data in ",!,"the Buffer File entry is deleted leaving only a stub entry for tracking ",!,"and reporting purposes."
54 W !!,"The IB INSURANCE SUPERVISOR key is required to either Accept or Reject an entry."
55 D PAUSE^VALM1 S VALMBCK="R"
56 Q
57 ;
58EXIT ; exit list manager option and clean up
59 K ^TMP("IBCNBLL",$J),^TMP("IBCNBLLX",$J),^TMP("IBCNBLLY",$J),^TMP($J,"IBCNBLLS"),IBCNSORT,IBCNSCRN,DFN,IBINSDA,IBFASTXT,IBBUFDA
60 D CLEAR^VALM1
61 Q
62 ;
63BLD ; build screen display
64 N IBCNT,IBCNS1,IBCNS2,IBBUFDA,IBLINE
65 ;
66 D SORT S IBCNT=0,VALMCNT=0,IBBUFDA=0
67 ;
68 S IBCNS1="" F S IBCNS1=$O(^TMP($J,"IBCNBLLS",IBCNS1)) Q:IBCNS1="" D
69 . S IBCNS2="" F S IBCNS2=$O(^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2)) Q:IBCNS2="" D
70 .. S IBBUFDA=0 F S IBBUFDA=$O(^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA)) Q:'IBBUFDA D
71 ... ;
72 ... S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#15) W "."
73 ... S IBLINE=$$BLDLN(IBBUFDA,IBCNT)
74 ... D SET(IBLINE,IBCNT)
75 ;
76 I VALMCNT=0 D SET("",0),SET("There are no Buffer entries that have not been processed.",0)
77 Q
78 ;
79BLDLN(IBBUFDA,IBCNT) ; build line to display on List screen for one Buffer entry
80 N DFN,IB0,IB20,IB60,IBLINE,IBY,VAIN,VADM,VA,VAERR,X,Y,IBMTS S IBLINE="",IBBUFDA=+$G(IBBUFDA)
81 S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB60=$G(^IBA(355.33,IBBUFDA,60))
82 S DFN=+IB60 I +DFN D DEM^VADPT,INP^VADPT
83 ;
84 S IBY=$G(IBCNT),IBLINE=$$SETSTR^VALM1(IBY,"",1,4)
85 ;
86 ; ESG - 6/6/02 - SDD 5.1.8
87 ; pull the symbol from the symbol function
88 ;
89 S IBY=$$SYMBOL(IBBUFDA)
90 S IBY=IBY_$P($G(^DPT(+DFN,0)),U,1),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,5,16)
91 S IBY=$G(VA("BID")),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,23,4)
92 S IBY=$P(IB20,U,1),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,29,17)
93 S IBY=$P(IB60,U,4),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,48,10)
94 S IBY=$$GET1^DIQ(355.12,$P(IB0,U,3),.03),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,60,5)
95 S IBY=$$DATE(+IB0),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,66,8)
96 S IBY="" D S IBLINE=$$SETSTR^VALM1(IBY,IBLINE,76,5)
97 . S IBY=IBY_$S(+$$INSURED^IBCNS1(DFN,DT):"i",1:" ")
98 . S IBY=IBY_$S(+$G(VAIN(1)):"I",1:" ")
99 . S IBY=IBY_$S(+$G(VADM(6)):"E",1:" ")
100 . S IBMTS=$P($$LST^DGMTU(DFN),U,4)
101 . S IBY=IBY_$S(IBMTS="C":"Y",IBMTS="G":"Y",1:" ")
102 . S IBY=IBY_$S(+$$HOLD(DFN):"H",1:" ")
103 Q IBLINE
104 ;
105SET(LINE,CNT) ; set up list manager screen display array
106 S VALMCNT=VALMCNT+1
107 S ^TMP("IBCNBLL",$J,VALMCNT,0)=LINE Q:'CNT
108 S ^TMP("IBCNBLL",$J,"IDX",VALMCNT,+CNT)=""
109 S ^TMP("IBCNBLLX",$J,CNT)=VALMCNT_U_IBBUFDA
110 S ^TMP("IBCNBLLY",$J,IBBUFDA)=VALMCNT_U_+CNT
111 Q
112 ;
113SORT ; set up sort for list screen
114 ; 1^PATIENT NAME, 2^INS NAME, 3^SOURCE OF INFO, 4^DATE ENTERED, 5^INPATIENT (Y/N), 6^MEANS TEST (Y/N), 7^ON HOLD, 8^VERIFIED, 9^IIV STATUS
115 N IBCNDT,IBBUFDA,IBCNDFN,IBCNPAT,IBCSORT1,IBCSORT2,DFN,VAIN,VA,VAERR,IBX,IBCNT,X,Y S IBCNT=0
116 ;
117 K ^TMP($J,"IBCNBLLS") I '$G(IBCNSORT) S IBCNSORT="1^Patient Name"
118 ;
119 S IBCNDT=0 F S IBCNDT=$O(^IBA(355.33,"AEST","E",IBCNDT)) Q:'IBCNDT D
120 . S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AEST","E",IBCNDT,IBBUFDA)) Q:'IBBUFDA D
121 .. S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#15) W "."
122 .. ;
123 .. S IBCNDFN=+$G(^IBA(355.33,IBBUFDA,60)),IBCNPAT="" I +IBCNDFN S IBCNPAT=$P($G(^DPT(IBCNDFN,0)),U,1)
124 .. ;
125 .. I +IBCNSORT=1 S IBCSORT1=IBCNPAT
126 .. I +IBCNSORT=2 S IBCSORT1=$P($G(^IBA(355.33,IBBUFDA,20)),U,1)
127 .. I +IBCNSORT=3 S IBCSORT1=$P($G(^IBA(355.33,IBBUFDA,0)),U,3)
128 .. I +IBCNSORT=4 S IBCSORT1=$P(+$G(^IBA(355.33,IBBUFDA,0)),".",1)
129 .. I +IBCNSORT=5 I +IBCNDFN S DFN=+IBCNDFN D INP^VADPT S IBCSORT1=$S($G(VAIN(1)):1,1:2)
130 .. I +IBCNSORT=6 I +IBCNDFN S IBX=$P($$LST^DGMTU(IBCNDFN),U,4) S IBCSORT1=$S(IBX="C":1,IBX="G":1,1:2)
131 .. I +IBCNSORT=7 I +IBCNDFN S IBX=$$HOLD(IBCNDFN) S IBCSORT1=$S(+IBX:1,1:2)
132 .. I +IBCNSORT=8 S IBCSORT1=$S(+$P($G(^IBA(355.33,IBBUFDA,0)),U,10):1,1:2)
133 .. ; Sort by symbol and then within the symbol, sort by date entered
134 .. ; Build a numerical subscript with format ##.FM date
135 .. I +IBCNSORT=9 S IBCSORT1=$G(IBCNSORT(1,$$SYMBOL(IBBUFDA)))_"."_$P(+$G(^IBA(355.33,IBBUFDA,0)),".",1),IBCSORT1=+IBCSORT1
136 .. ;
137 .. S IBCSORT1=$S($G(IBCSORT1)="":"~UNKNOWN",1:IBCSORT1),IBCSORT2=$S(IBCNPAT="":"~UNKNOWN",1:IBCNPAT)
138 .. ;
139 .. S ^TMP($J,"IBCNBLLS",IBCSORT1,IBCSORT2,IBBUFDA)="" K VAIN,IBCSORT1
140 I IBCNT,'$D(ZTQUEUED) W "|"
141 Q
142 ;
143DATE(X) ;
144 Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
145HOLD(DFN) ; returns true if patient has bills On Hold
146 Q $D(^IB("AH",+$G(DFN)))
147 ;
148SYMBOL(IBBUFDA) ; Returns the symbol for this buffer entry
149 NEW IB0,SYM
150 S IB0=$G(^IBA(355.33,IBBUFDA,0)),SYM=""
151 I +$P(IB0,U,12) S SYM=$C($P($G(^IBE(365.15,+$P(IB0,U,12),0)),U,2))
152 ; If the entry has been manually verified, override the symbol displayed
153 I $P(IB0,U,10)'="",'+$P(IB0,U,12) S SYM="*"
154 I SYM="" S SYM=" "
155 Q SYM
156 ;
157 ;
158UPDLN(IBBUFDA,ACTION) ; *** called by any action that modifies a buffer entry, so list screen can be updated if screen not recompiled
159 ; modifies a single line in the display array for a buffer entry that has been modified in some way
160 ; ACTION = REJECTED, ACCEPTED, EDITED
161 N IBARRN,IBOLD,IBNEW,IBO,IBN S IBO="0123456789",IBN="----------"
162 ;
163 S IBARRN=$G(^TMP("IBCNBLLY",$J,+$G(IBBUFDA))) Q:'IBARRN
164 S IBOLD=$G(^TMP("IBCNBLL",$J,+IBARRN,0)) Q:IBOLD=""
165 ;
166 ; if action is REJECTED or ACCEPTED then the patient name is replaced by the Action in the display array
167 ; and the buffer entry is removed from the list of entries that can be selected
168 I (ACTION="REJECTED")!(ACTION="ACCEPTED") D
169 . S IBNEW=$TR($E(IBOLD,1,5),IBO,IBN)_ACTION_$J("",7)_$E(IBOLD,21,999)
170 . S ^TMP("IBCNBLL",$J,+IBARRN,0)=IBNEW
171 ;
172 ; if the action is EDITED then the line for the buffer entry is recomplied and the updated line is set into
173 ; the display array
174 I ACTION="EDITED" D
175 . S IBNEW=$$BLDLN(IBBUFDA,+$P(IBARRN,U,2))
176 . S ^TMP("IBCNBLL",$J,+IBARRN,0)=IBNEW
177 Q
Note: See TracBrowser for help on using the repository browser.