source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPTC2.m@ 1015

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1IBCEPTC2 ;ALB/TMK - EDI PREVIOUSLY TRANSMITTED CLAIMS LIST MGR ;01/20/05
2 ;;2.0;INTEGRATED BILLING;**296,320,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ; IA 3337 for file 430.3
5 ;
6HDR ;
7 K VALMHDR
8 S VALMHDR(1)="** A claim may appear multiple times if transmitted more than once. **"
9 ;
10 I $G(IBSORT)=1 D
11 . S VALMHDR(2)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)"
12 . Q
13 ;
14 I $G(IBSORT)=2 D
15 . S VALMHDR(2)="** T = Test Claim ** R = Batch Rejected"
16 . S VALMHDR(3)="Claims Selected: "_+$G(^TMP("IB_PREV_CLAIM_SELECT",$J))_" (marked with *)"
17 . Q
18 ;
19 Q
20 ;
21INIT ;
22 S VALMCNT=0,VALMBG=1
23 D BLD
24 Q
25 ;
26BLD ; Build display lines
27 N IBDA,IBS1,IBS2,IBIFN,IB0,IBX,IBCNT,IBLEV1,IBBDA
28 K ^TMP("IB_PREV_CLAIM_LIST",$J),^TMP("IB_PREV_CLAIM_SELECT",$J),^TMP("IB_PREV_CLAIM_BATCH",$J)
29 S IBCNT=0
30 I $O(^TMP("IB_PREV_CLAIM",$J,""))="" D G BLDQ
31 . S IBX=" ** NO PREVIOUSLY TRANSMITTED CLAIMS EXIST FOR SEARCH CRITERIA SELECTED **"
32 . D WRT(IBX,"",0,0,"","S","",.IBCNT,0)
33 ;
34 S IBS1="" F S IBS1=$O(^TMP("IB_PREV_CLAIM",$J,IBS1)) Q:IBS1="" D
35 . ; First level sort
36 . ; for sort by batch, display batch ID and transmit date
37 . I IBSORT=1 D
38 .. S IBLEV1=" Batch: "_$P(IBS1,U,2)_" Last Transmitted: "_$G(^TMP("IB_PREV_CLAIM",$J,IBS1))
39 .. S IBBDA=+$O(^IBA(364.1,"B",$P(IBS1,U,2),0))
40 .. I $P(IBS1,U,3) S IBLEV1=IBLEV1_" ** Test"
41 .. I $P(IBS1,U,4) S IBLEV1=IBLEV1_" ** Rejected"
42 .. Q
43 . ;
44 . ; for sort by payer, display ins co name and payer address
45 . I IBSORT=2 D
46 .. S IBLEV1=" "_$P(IBS1,U)_" "_$$CURRINS(+$G(^TMP("IB_PREV_CLAIM",$J,IBS1)),0)
47 .. Q
48 . ;
49 . ; output sort header line
50 . D WRT(IBLEV1,"",0,0,IBSORT,"S","",IBCNT,0) ; Add header line
51 . ;
52 . I IBSORT=1,IBBDA S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBBDA)=VALMCNT
53 . S IBS2="" F S IBS2=$O(^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2)) Q:IBS2="" S IBDA=0 F S IBDA=$O(^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IBDA)) Q:'IBDA D
54 .. N IBX,IBTEST
55 .. S IBIFN=+$G(^IBA(364,+IBDA,0)),IB0=$G(^DGCR(399,IBIFN,0))
56 .. S IBX=$P(^TMP("IB_PREV_CLAIM",$J,IBS1,IBS2,IBDA),U,1)
57 .. I IBX=1 S IBTEST=0 ; live 364 transmission
58 .. I IBX=2 S IBTEST=1 ; test 364 transmission
59 .. I IBX=3 S IBTEST=1 ; test 361.4 transmission
60 .. D WRT(IBS1,IBS2,IBDA,IBIFN,IBSORT,"S","",.IBCNT,0,IBTEST)
61 .. I IBSORT=1,IBBDA S ^TMP("IB_PREV_CLAIM_BATCH",$J,IBBDA,VALMCNT)=IBIFN_U_IBCNT
62 .. Q
63 . Q
64 ;
65BLDQ Q
66 ;
67EXIT ; Clean up code
68 ;
69 K ^TMP("IB_PREV_CLAIM_LIST",$J)
70 K ^TMP("IB_PREV_CLAIM_SELECT",$J)
71 K ^TMP("IB_PREV_CLAIM_LIST_DX",$J)
72 K ^TMP("IB_PREV_CLAIM_BATCH",$J)
73 D CLEAR^VALM1
74 Q
75 ;
76WRT(IBS1,IBS2,IBDA,IBIFN,IBSORT,IBREP,IBHDR,IBPAGE,IBSTOP,IBTEST) ; Wrt/output
77 ;
78 N IBX,IB0,Z,IBCNT,ARSTAT
79 S IBCNT=IBPAGE
80 ;
81 I 'IBIFN D G WRTQ
82 . ;
83 . ; for report output
84 . I IBREP="R" D Q
85 .. S Z="",$P(Z,"=",133)=""
86 .. D SET(Z,1,IBDA,IBREP,IBHDR,1,0,.IBPAGE,.IBSTOP)
87 .. D SET(IBS1,2,IBDA,IBREP,IBHDR,1,0,.IBPAGE,.IBSTOP)
88 .. Q
89 . ;
90 . ; for ListMan screen output
91 . D SET(IBS1,0,IBDA,IBREP,IBHDR,IBCNT+1,.VALMCNT,.IBPAGE,.IBSTOP)
92 . Q
93 ;
94 S IB0=$G(^DGCR(399,IBIFN,0))
95 S IBX=$$FO^IBCNEUT1($P(IB0,U,1),8) ; claim#
96 S IBX=IBX_$S(IBSORT=2&$G(IBTEST):"T",1:" ")_" "
97 S IBX=IBX_$S($P(IB0,U,19)=2:"1500",1:"UB04")_" "
98 S Z=$$INPAT^IBCEF(IBIFN) S IBX=IBX_$S(Z:"INPT ",1:"OUTPT")
99 S IBX=IBX_$J($P(IB0,U,21),3)_" "
100 S Z=$$EXTERNAL^DILFD(399,.13,"",$P(IB0,U,13))
101 S IBX=IBX_$$FO^IBCNEUT1(Z,11)_" " ; claim status
102 S ARSTAT=+$P($$BILL^RCJIBFN2(IBIFN),U,2) ; ien
103 S ARSTAT=$P($G(^PRCA(430.3,ARSTAT,0)),U,2) ; abbreviation
104 S IBX=IBX_$$FO^IBCNEUT1(ARSTAT,4) ; a/r status display
105 ;
106 I IBSORT=1 D ; sort by batch
107 . N Z,IBZ,IBXDATA
108 . ; Print current payer, payer address, other payers, pat name
109 . D F^IBCEF("N-CURR INSURANCE COMPANY NAME","IBZ",,IBIFN)
110 . S IBX=IBX_$$FO^IBCNEUT1(IBZ,25)_" " ; ins co name
111 . S IBX=IBX_$$FO^IBCNEUT1($$CURRINS(IBIFN,1),29)_" " ; address
112 . K IBZ D F^IBCEF("N-OTH INSURANCE CO. NAME","IBZ",,IBIFN)
113 . S IBX=IBX_$$FO^IBCNEUT1($P($G(IBZ(1)),U,1),15)_" " ; other payer
114 . S Z=$P($G(^DPT(+$P(IB0,U,2),0)),U,1)
115 . S IBX=IBX_$E(Z,1,18) ; patient name
116 . ;
117 . ; set line into list
118 . S IBCNT=IBCNT+1
119 . D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
120 . S IBX=""
121 . ;
122 . I $G(IBZ(2))'="" D ; other payer #2 if it exists
123 .. S IBX=$J("",98)_$E($P(IBZ(2),U,1),1,15)
124 .. D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
125 .. Q
126 . Q
127 ;
128 I IBSORT=2 D ; sort by payer
129 . N Z,IBZ
130 . S IBX=IBX_" "
131 . ; Print other payers, patient name, date last trans, batch #, reject flag
132 . D F^IBCEF("N-OTH INSURANCE CO. NAME","IBZ",,IBIFN)
133 . S IBX=IBX_$$FO^IBCNEUT1($P($G(IBZ(1)),U,1),18)_" " ; oth payer#1
134 . S Z=$P($G(^DPT(+$P(IB0,U,2),0)),U,1)
135 . S IBX=IBX_$$FO^IBCNEUT1(Z,18)_" " ; patient name
136 . ;
137 . S Z=+$P($G(^IBA(364,+IBDA,0)),U,2) ; Batch ptr
138 . S IBX=IBX_$$FO^IBCNEUT1($$FMTE^XLFDT($P($G(^IBA(364.1,+Z,1)),U,3)\1,"1"),17) ; date last transmitted
139 . S IBX=IBX_$$FO^IBCNEUT1($P($G(^IBA(364.1,Z,0)),U,1),10) ; batch#
140 . S IBX=IBX_$S($P($G(^IBA(364.1,Z,0)),U,5):" R",1:"") ; batch rejected flag
141 . ;
142 . ; set line into list
143 . S IBCNT=IBCNT+1
144 . D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
145 . S IBX=""
146 . ;
147 . I $G(IBZ(2))'="" D ; other payer#2 if it exists
148 .. S IBX=$J("",44)_$E($P(IBZ(2),U),1,18)
149 .. D SET(.IBX,1,IBDA,IBREP,IBHDR,IBCNT,.VALMCNT,.IBPAGE,.IBSTOP)
150 .. Q
151 . Q
152 ;
153WRTQ I IBREP="S" S IBPAGE=IBCNT
154 Q
155 ;
156SET(IBX,IBLINE,IBDA,IBREP,IBHDR,IBCNT,VALMCNT,IBPAGE,IBSTOP) ;
157 N Q,Z,IBZ
158 S IBZ=IBX,IBX=""
159 I IBREP="R" D Q
160 . D:($Y+5)>IOSL!'IBPAGE HDR^IBCEPTC1(IBHDR,IBSORT,.IBPAGE,.IBSTOP) D
161 . I IBLINE F Z=1:1:IBLINE W !
162 . W:'IBSTOP IBZ
163 . Q
164 ;
165 ; only display the counter if we have a line with the claim#
166 S VALMCNT=VALMCNT+1
167 I IBDA,$TR($E(IBZ,1,8)," ")'="" S IBZ=$$FO^IBCNEUT1($J(IBCNT,3),6)_IBZ
168 I IBDA,$TR($E(IBZ,1,8)," ")="" S IBZ=" "_IBZ
169 ;
170 S ^TMP("IB_PREV_CLAIM_LIST",$J,VALMCNT,0)=IBZ
171 S ^TMP("IB_PREV_CLAIM_LIST",$J,"IDX",VALMCNT,IBCNT)=""
172 I IBDA,$TR($E(IBZ,1,8)," ")'="" S ^TMP("IB_PREV_CLAIM_LIST_DX",$J,IBCNT)=VALMCNT_U_IBDA
173 Q
174 ;
175CURRINS(IBIFN,TRUNC) ; Returns Current insurance address for given claim
176 ; TRUNC = truncate flag; 1 to truncate the address and city
177 N IBX,IBZ,L1,CITY,ST
178 D F^IBCEF("N-CURR INS CO FULL ADDRESS","IBZ",,IBIFN)
179 S L1=$G(IBZ(1)) I +$G(TRUNC) S L1=$E(L1,1,15)
180 S CITY=$G(IBZ(4)) I +$G(TRUNC) S CITY=$E(CITY,1,10)
181 S ST=$G(IBZ(5))
182 I ST S ST=$P($G(^DIC(5,ST,0)),U,2)
183 S IBX=L1_" "_CITY
184 I CITY'="",ST'="" S IBX=IBX_","_ST
185 E S IBX=IBX_" "_ST
186 Q IBX
187 ;
Note: See TracBrowser for help on using the repository browser.