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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1IBCNRRP3 ;BHAM ISC/CMW - GROUP PLAN WORKSHEET REPORT PRINT ;03-MAR-2004
2 ;;2.0;INTEGRATED BILLING;**251,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; ePHARM GROUP PLAN WORKSHEET REPORT
6 ;
7 ; Called by IBCNRRP1
8 ;
9 ; Input variables from IBCNRRP1 and IBCNRRP2:
10 ; IBCNRRTN = "IBCNRRP1"
11 ; IBCNRSPC("BEGDT") = Start Date for dt range
12 ; IBCNRSPC("ENDDT") = End Date for dt range
13 ; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims;
14 ; 3 - Total Charges; 4 - Exceptions
15 ; IBCNRSPC("MATCH") = 1 - Matched Only; 0 - All;
16 ;
17 ; ^TMP(IBCNRRTN,1); ^TMP(IBCNRRTN,2); ^TMP(IBCNRRTN,3)
18 ; Must call at appropriate tag
19 Q
20 ;
21 ;
22EN(IBCNRRTN,IBCNRSPC) ; Entry pt.
23 ;
24 ; Init vars
25 N CRT,MAXCNT,IBPGC,IBBDT,IBEDT,IBMAT,IBPY,IBPXT,IBSRT,IBDTL
26 N X,Y,DIR,DTOUT,DUOUT,LIN,TOTALS
27 ;
28 S IBBDT=$G(IBCNRSPC("BEGDT"))
29 S IBEDT=$G(IBCNRSPC("ENDDT"))
30 S IBSRT=$G(IBCNRSPC("SORT"))
31 S IBMAT=$G(IBCNRSPC("MATCH"))
32 S (IBPXT,IBPGC)=0
33 ;
34 ; Determine IO parameters
35 I IOST["C-" S MAXCNT=IOSL-3,CRT=1
36 E S MAXCNT=IOSL-6,CRT=0
37 ;
38 D PRINT(IBCNRRTN,IBBDT,IBEDT,IBSRT,MAXCNT,IBPGC,IBMAT)
39 I $G(ZTSTOP)!IBPXT G EXIT3
40 I CRT,IBPGC>0,'$D(ZTQUEUED) D
41 . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
42 . S DIR(0)="E" D ^DIR K DIR
43 ;
44EXIT3 ; Exit pt
45 Q
46 ;
47PRINT(RTN,BDT,EDT,SRT,MAX,PGC,MAT) ; Print data
48 ; Input params: RNT = "IBCNRRP1" - routine, BDT = starting dt,
49 ; EDT = ending dt
50 ; SRT = 1/2/3
51 ; MAT = 1/0
52 ;
53 ; Init vars
54 N EORMSG,NONEMSG,TOTDASHS,DISPDATA,SORT,CT,PRT1,PRT2
55 ;
56 S EORMSG="*** END OF REPORT ***"
57 S NONEMSG="* * * N O D A T A F O U N D * * *"
58 S $P(TOTDASHS,"=",89)=""
59 S CT=0
60 ;
61 I '$D(^XTMP(RTN)) D HEADER W !,?(132-$L(NONEMSG)\2),NONEMSG,!! G PRINT2
62 ;
63 ; Build lines of data to display
64 K ^TMP("IBCNR",$J,"RPTDATA")
65 D DATA
66 K ^TMP("IBCNR",$J,"DSPDATA")
67 D DISP
68 ; Display lines of response
69 D LINE
70 K ^TMP("IBCNR",$J,"DSPDATA"),^TMP("IBCNR",$J,"RPTDATA")
71 Q
72 ;
73PRINT2 I $G(ZTSTOP)!IBPXT G PRINTX
74 I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!$G(IBPXT) G PRINTX
75 W !,?(132-$L(EORMSG)\2),EORMSG
76 ;
77PRINTX ; PRINT exit point
78 Q
79 ;
80HEADER ; Print header info for each page
81 ; Assumes vars from PRINT: CRT,PGC,IBPXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
82 ; Init vars
83 N DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,DASHES2,LIN
84 ;
85 I CRT,PGC>0,'$D(ZTQUEUED) D I IBPXT G HEADERX
86 . I MAX<51 F LIN=1:1:(MAX-$Y) W !
87 . S DIR(0)="E" D ^DIR K DIR
88 . I $D(DTOUT)!$D(DUOUT) S IBPXT=1 Q
89 I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 G HEADERX
90 S PGC=PGC+1
91 W @IOF,!,?1,"ePHARM GROUP PLAN WORKSHEET REPORT"
92 S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
93 S OFFSET=80-$L(HDR)
94 W ?OFFSET,HDR
95 W !,?1,"Claims with Pharmacy Coverage Sorted by: "_$S(SRT=1:"Insurance/Group",SRT=2:"Max. Total Claims",1:"Max. Total Charges")
96 S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
97 S OFFSET=80-$L(HDR)\2
98 W !,?OFFSET,HDR
99 ; Display column headings
100 W !,?1,"Insurance Company Name",?40,"Insurance Company Address"
101 W !,?3,"Group Name/Number",?42,"Pharmacy Plan",?60," BIN",?70,"PCN"
102 S $P(DASHES,"=",80)=""
103 W !,?1,DASHES
104 ;
105HEADERX ; HEADER exit pt
106 Q
107 ;
108LINE ; Print line of data
109 ; Assumes vars from PRINT: PGC,IBPXT,MAX
110 ; Init vars
111 N CT,II
112 ;
113 S CT=+$O(^TMP("IBCNR",$J,"DSPDATA",""),-1)
114 I $Y+1+CT>MAX D HEADER I $G(ZTSTOP)!IBPXT G LINEX
115 F II=1:1:CT D Q:$G(ZTSTOP)!IBPXT
116 . I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!IBPXT Q
117 . W !,?1,^TMP("IBCNR",$J,"DSPDATA",II)
118 . Q
119 ;
120LINEX ; LINE exit pt
121 Q
122 ;
123DATA ; Gather and format lines of data to be printed
124 ; Assumes vars from PRINT: RTN,SRT,SRT,RDTL,CT,PRT1,PRT2
125 ; Init vars
126 ;
127 ;Loop through and sort TMP file
128 N CNT,IBINS,IBINSNM,IBGRP,IBGRPNM,IBGRPNB,RPDT,RPTOT,RPTCNT,RPTCHG
129 N IBGRP0,IBGRP6,IBGRPNM,IBPLBIN,IBPLNNM,IBPLPCN,IBPPIEN
130 S IBINS=0,CNT=0
131 F S IBINS=$O(^XTMP(RTN,IBINS)) Q:IBINS="" D
132 . ;get insurance company name
133 . S IBINSNM=$P($G(^DIC(36,IBINS,0)),U)
134 . I IBINSNM="" S IBINSNM="NO NAME EXISTS"
135 . S IBGRP=0
136 . F S IBGRP=$O(^XTMP(RTN,IBINS,IBGRP)) Q:IBGRP="" D
137 .. ;get group info
138 .. S IBGRP0=$G(^IBA(355.3,IBGRP,0))
139 .. ;get pharmacy plan info
140 .. S IBGRP6=$G(^IBA(355.3,IBGRP,6))
141 .. I 'IBGRP6,$G(MAT) Q ; Matched only
142 .. I IBGRP0 D
143 ... S (IBGRPNM,IBGRPNB)=""
144 ... S IBGRPNM=$P($G(IBGRP0),U,3) I $G(IBGRPNM)="" S IBGRPNM="<blank>"
145 ... S IBGRPNB=$P($G(IBGRP0),U,4) I $G(IBGRPNB)="" S IBGRPNB="<blank>"
146 ... S RPDT=IBGRPNB
147 .. I IBGRP6 D
148 ... S (IBPPIEN,IBPLNNM,IBPLPCN)=""
149 ... S IBPPIEN=$P($G(IBGRP6),U)
150 ... S IBPLNNM=$P($G(^IBCNR(366.03,IBPPIEN,0)),U,2)
151 ... S IBPLBIN=$P($G(^IBCNR(366.03,IBPPIEN,10)),U,2)
152 ... S IBPLPCN=$P($G(^IBCNR(366.03,IBPPIEN,10)),U,3)
153 ... S RPDT=$G(RPDT)_U_$G(IBPLNNM)_U_$G(IBPLBIN)_U_$G(IBPLPCN)
154 .. E S RPDT=$G(RPDT)_U_U_U
155 .. S RPDT=$G(RPDT)_U_$P($G(IBGRP6),U,2,3)
156 .. S RPTOT=^XTMP(RTN,IBINS,IBGRP)
157 .. S RPTCNT=$P(RPTOT,U),RPTCHG=$P(RPTOT,U,2)
158 .. I SRT=1 D Q
159 ... S ^TMP("IBCNR",$J,"RPTDATA",SRT,IBINSNM,IBINS,IBGRPNM,IBGRP)=$G(RPDT)
160 .. I SRT=2 D Q
161 ... S ^TMP("IBCNR",$J,"RPTDATA",-$G(RPTCNT),IBINSNM,IBINS,IBGRPNM,IBGRP)=$G(RPDT)
162 .. I SRT=3 D Q
163 ... S ^TMP("IBCNR",$J,"RPTDATA",-$G(RPTCHG),IBINSNM,IBINS,IBGRPNM,IBGRP)=$G(RPDT)
164 .. I SRT=4 D Q
165 ... I '$G(IBGRP6) Q
166 ... N OK S OK=1
167 ... I $G(IBPLBIN)'="",$P(IBGRP6,U,2)'="",IBPLBIN'=$P(IBGRP6,U,2) S OK=0
168 ... I $G(IBPLPCN)'="",$P(IBGRP6,U,3)'="",IBPLPCN'=$P(IBGRP6,U,3) S OK=0
169 ... I 'OK S ^TMP("IBCNR",$J,"RPTDATA",SRT,IBINSNM,IBINS,IBGRPNM,IBGRP)=$G(RPDT)
170 Q
171 ;
172DISP ;set up display data
173 N CNT,DISP1,DISP2,DISP3,DISP4,DISP5,DISPD,DASHES2
174 N IBCNADR,IBCIN11,IBCINST,I
175 S DISP1="",CNT=0,$P(DASHES2,"-",80)=""
176 F S DISP1=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1)) Q:DISP1="" D
177 . S DISP2=""
178 . F S DISP2=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2)) Q:DISP2="" D
179 .. S DISP3=0
180 .. F S DISP3=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2,DISP3)) Q:DISP3="" D
181 ... S DISP4=""
182 ... F S DISP4=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2,DISP3,DISP4)) Q:DISP4="" D
183 .... S DISP5=0
184 .... F S DISP5=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2,DISP3,DISP4,DISP5)) Q:DISP5="" D
185 ..... S DISPD=$G(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2,DISP3,DISP4,DISP5))
186 ..... ;get insurance addr
187 ..... S IBCIN11=$G(^DIC(36,DISP3,.11))
188 ..... S IBCINST=$S($P(IBCIN11,U,5)="":"--",1:$P($G(^DIC(5,$P(IBCIN11,U,5),0)),U,2))
189 ..... S IBCNADR=$E($P(IBCIN11,U),1,15)_","_$E($P(IBCIN11,U,4),1,10)_","_IBCINST_" "_$E($P(IBCIN11,U,6),1,5)
190 ..... S CNT=CNT+1
191 ..... ;insurance co and group/plan
192 ..... S ^TMP("IBCNR",$J,"DSPDATA",CNT)=$$FO^IBCNEUT1(DISP2,40)_$$FO^IBCNEUT1(IBCNADR,35,"L")
193 ..... ;bin; pcn; and pharmacy plan
194 ..... S CNT=CNT+1
195 ..... S ^TMP("IBCNR",$J,"DSPDATA",CNT)=$$FO^IBCNEUT1(DISP4_"/"_$P(DISPD,U),35,"L")_$$FO^IBCNEUT1(" "_$P(DISPD,U,2),24,"L")_$$FO^IBCNEUT1(" "_$P(DISPD,U,3),10,"L")_$$FO^IBCNEUT1($P(DISPD,U,4),10,"L")
196 ..... S I=$$FO^IBCNEUT1("",60)_$$FO^IBCNEUT1($P(DISPD,U,5),10,"L")_$$FO^IBCNEUT1($P(DISPD,U,6),10,"L")
197 ..... I $TR(I," ")'="" S CNT=CNT+1,^TMP("IBCNR",$J,"DSPDATA",CNT)=I
198 ..... S CNT=CNT+1
199 ..... S ^TMP("IBCNR",$J,"DSPDATA",CNT)=$$FO^IBCNEUT1(DASHES2,79,"L")
200 ;
201DATAX ; DATA exit pt
202 K RPTDATA
203 Q
204 ;
Note: See TracBrowser for help on using the repository browser.