source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSRPAY.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1BPSRPAY ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
3 ;; Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6 ;
7 ; Payer Sheet Display Report
8 ;
9 ;User Prompts
10EN N BPFILE,BPIEN,BPSCR,BPQ
11 S BPFILE=9002313.92
12 ;
13 ;Select Payer Sheet
14 I $D(IOF) W @IOF
15 W !,"Payer Sheet Detail Report",!!
16 S BPIEN=$$BPIEN(BPFILE)
17 ;
18 ;Check for Valid Entry
19 I BPIEN=-1 G EXIT
20 ;
21 ;Select Device
22 I $$DEVICE=-1 G EXIT
23 ;
24 ;Display Data
25 D RUN(BPFILE,BPIEN)
26 ;
27 ;Exit
28EXIT Q
29 ;
30 ;Display the Payer Sheet Info
31 ;
32RUN(BPFILE,BPIEN) N BPQ
33 D PSPRNT(BPFILE,BPIEN)
34 Q
35 ;
36 ; Select a payer sheet
37BPIEN(BPFILE) N DIC,DIRUT,DTOUT,DUOUT,X,Y
38 S DIC=$$ROOT^DILFD(BPFILE),DIC(0)="AEMQ"
39 S DIC("A")="Select Payer Sheet: "
40 D ^DIC
41 Q +Y
42 ;
43 ;Select the output Device
44DEVICE() N %ZIS,IOP,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,POP,BPQ
45 S BPQ=0
46 S %ZIS="QM"
47 W ! D ^%ZIS
48 I POP Q -1
49 S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
50 I $D(IO("Q")) D S BPQ=-1
51 . S ZTRTN="RUN^BPSRPAY(BPFILE,BPIEN)"
52 . S ZTIO=ION
53 . S ZTSAVE("*")=""
54 . S ZTDESC="PAYER SHEET DETAIL REPORT"
55 . D ^%ZTLOAD
56 . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
57 . D HOME^%ZIS
58 U IO
59 Q BPQ
60 ;
61 ; Payer Sheet Display
62PSPRNT(BPFILE,EN) N BPSHDR,BPIEN,BPPAGE,BPQ,CD,L,N,N1,N2,NAME,NM,NUM,SEG,SP
63 N SEGNM,TB,WP,X,X0,X5,ZTREQ
64 ;
65 ; Build List of Segment Header Names
66 D INIT
67 ;
68 ; Get header information
69 S BPIEN=EN_","
70 D GETS^DIQ(BPFILE,EN,".01;1.02;1.03;1.06;1.07;1.13;1.14;1001","","BPSHDR")
71 ;
72 ; Display Header Information
73 S BPQ=0,BPPAGE=0,SEGNM=""
74 D HDR
75 ;
76 ; Field Detail Information
77 ; Loop through Segments
78 S SEG=99 F S SEG=$O(^BPSF(BPFILE,EN,SEG)) Q:SEG=""!(SEG>230)!(SEG="REVERSAL") D I BPQ Q
79 . ;
80 . ;Make sure there are entries for the segment
81 . I $P($G(^BPSF(BPFILE,EN,SEG,0)),U,4)<1 Q
82 . ;
83 . ; Get and display Segment Name
84 . S SEGNM=$G(NAME(SEG))
85 . ; Check that we can display the Segment Name and at least one additional field
86 . D CHKP(2) I BPQ Q
87 . I BPPAGE=1!($Y>5) W !,?((60-$L(SEGNM)+8)/2),"*** ",SEGNM," ***"
88 . ; Loop through the Field via the Sequence Number
89 . S N=0 F S N=$O(^BPSF(BPFILE,EN,SEG,"B",N)) Q:N="" D I BPQ Q
90 .. S N1=0 F S N1=$O(^BPSF(BPFILE,EN,SEG,"B",N,N1)) Q:N1="" D I BPQ Q
91 ... ;
92 ... ; Get Field Data and Format the Field Number
93 ... S X=$G(^BPSF(BPFILE,EN,SEG,N1,0))
94 ... S NUM=$P(X,U,2),SP=$P(X,U,3)
95 ... I NUM S X0=$G(^BPSF(9002313.91,NUM,0)),X5=$G(^BPSF(9002313.91,NUM,5))
96 ... E S (X0,X5)=""
97 ... S NUM=$P(X0,U,1)_"-"_$P(X5,U,1),NM=$P(X0,U,3)
98 ... ;
99 ... ; Display the field information
100 ... D CHKP(1) I BPQ Q
101 ... W !,N,?5,NUM,?17,NM,?71,$J(SP,9)
102 ... ;
103 ... ; If there is special code, display it
104 ... I SP="X" S N2=0 F S N2=$O(^BPSF(BPFILE,EN,SEG,N1,1,N2)) Q:N2="" D I BPQ Q
105 .... S CD=$G(^BPSF(BPFILE,EN,SEG,N1,1,N2,0))
106 .... S TB=19,L=61,WP=0
107 .... F D CHKP(1) Q:BPQ W ! D Q:CD=""
108 ..... W:N2=1 ?5,"Special Code: "
109 ..... W:WP=1 ?12,"<cont>"
110 ..... W ?19,$E(CD,1,L)
111 ..... S CD=$E(CD,L+1,200) Q:CD=""
112 ..... S WP=1
113 . I BPQ Q
114 .D CHKP(1) Q:BPQ W !
115 I 'BPSCR W !,@IOF
116 E I 'BPQ D PAUSE2
117 I $D(ZTQUEUED) S ZTREQ="@" Q
118 D ^%ZISC
119XPRT Q
120 ;
121 ;Display Report Header
122 ;
123HDR S BPPAGE=$G(BPPAGE)+1
124 W @IOF
125 W "Payer Sheet Detail Report"
126 W ?48,"Print Date: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
127 W " Page:",$J(BPPAGE,3)
128 W !,$J("Payer Sheet Name: ",20),$G(BPSHDR(BPFILE,BPIEN,.01))
129 W ?40,$J("Version Number: ",20),$G(BPSHDR(BPFILE,BPIEN,1.14))
130 I BPPAGE=1 D
131 . W !,$J("Status: ",20),$G(BPSHDR(BPFILE,BPIEN,1.06))
132 . W ?40,$J("NCPDP Version: ",20),$G(BPSHDR(BPFILE,BPIEN,1.02))
133 . W !,$J("Reversal Format: ",20),$G(BPSHDR(BPFILE,BPIEN,1.07))
134 . W ?40,$J("Reversal Sheet: ",20),$G(BPSHDR(BPFILE,BPIEN,1001))
135 . W !,$J("Transaction Count: ",20),$G(BPSHDR(BPFILE,BPIEN,1.03))
136 . W ?40,$J("Certification ID: ",20),$G(BPSHDR(BPFILE,BPIEN,1.13))
137 ;
138 ; Display subheader
139 W !!,"Seq",?5,"Field",?17,"Field Name",?71,"Proc Mode"
140 W !,"---",?5,"-----",?17,"----------",?71,"---------"
141 I $G(SEGNM)]"" W !,?((60-$L(SEGNM)+8)/2),"*** ",SEGNM," ***"
142 Q
143 ;
144 ;Check for End of Page
145 ;
146 ; Input variable -> BPLINES - Number of lines from bottom
147 ; CONT - 0 = New Entry, 1 = Continue Entry
148 ;
149CHKP(BPLINES) S BPLINES=BPLINES+1
150 I $G(BPSCR) S BPLINES=BPLINES+3
151 I $Y>(IOSL-BPLINES) D:$G(BPSCR) PAUSE Q:$G(BPQ) 0 D HDR Q 1
152 Q 0
153 ;
154PAUSE ;
155 N X
156 U IO(0)
157 R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
158 I '$T S X="^"
159 I X["^" S BPQ=1
160 U IO
161 Q
162 ;
163PAUSE2 ;
164 N X
165 U IO(0)
166 R !,"Press RETURN to continue: ",X:DTIME
167 U IO
168 Q
169 ;
170INIT ; Create local array of segment header names
171 S NAME(100)="Transaction Header Segment",NAME(110)="Patient Segment"
172 S NAME(120)="Insurance Segment",NAME(130)="Claim Segment"
173 S NAME(140)="Pharmacy Provider Segment",NAME(150)="Prescriber Segment"
174 S NAME(160)="COB/Other Payments Segment",NAME(170)="Workers' Compensation Segment"
175 S NAME(180)="DUR/PPS Segment",NAME(190)="Pricing Segment"
176 S NAME(200)="Coupon Segment",NAME(210)="Compound Segment"
177 S NAME(220)="Prior Authorization Segment",NAME(230)="Clinical Segment"
178 Q
Note: See TracBrowser for help on using the repository browser.