source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEAC.m@ 1094

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1RCDPEAC ;ALB/TMK - ACTIVE BILLS WITH EEOB ON FILE ;27-JAN-2004
2 ;;4.5;Accounts Receivable;**208**;Mar 20, 1995
3 ;
4EN ; Entrypoint for producing the report
5 N RCSORT,RCINS,ZTRTN,ZTDESC,ZTSAVE,ZTSK,%ZIS,POP
6 Q:'$$SELECT(.RCINS,.RCSORT)
7 W !
8 S %ZIS="QM" D ^%ZIS Q:POP
9 I $D(IO("Q")) D Q
10 . S ZTRTN="ENQ^RCDPEAC",ZTDESC="AR - ACTIVE BILLS WITH EEOB REPORT",ZTSAVE("RCINS")="",ZTSAVE("RCSORT")="",ZTSAVE("RCINS(")=""
11 . D ^%ZTLOAD
12 . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
13 . K ZTSK,IO("Q") D HOME^%ZIS
14 U IO
15 ;
16ENQ ; Queued entrypoint for the report
17 ; RCSORT and array RCINS must exist
18 ; RCINS = "A" for all ins co, "R" for range, "S" for selected individual
19 ; for RCINS="R" ("FR")=from payer name and ("TR")=to payer name
20 ; for RCINS="S" ("S",INS CO IEN IN FILE 36)=""
21 ; RCSORT = "PN" for sort by patient name followed by ;- if reverse order
22 ; "L4" for sort by patient SSN followed by ;- if reverse order
23 ;
24 N Z,Z0,RCACT,RCBILL,RCEOB,RCTOT,RCSTOP,RCNEW,RCZ,RCZ0
25 K ^TMP($J,"RCSORT")
26 S RCACT=+$O(^PRCA(430.3,"AC",102,0)) ; Get active status ien
27 G:'RCACT ENOUT
28 ;
29 S RCBILL=0
30 F S RCBILL=$O(^PRCA(430,"AC",RCACT,RCBILL)) Q:RCBILL="" I +$G(^PRCA(430,RCBILL,7))>0,$$INCLUDE(.RCINS,RCBILL),$$EEOB(RCBILL,.RCEOB) D
31 . S (RCTOT,RCEOB)=0 F S RCEOB=$O(RCEOB(RCEOB)) Q:'RCEOB S RCTOT=RCTOT+$G(^IBM(361.1,RCEOB,1)),^TMP($J,"RCSORT",$$INSNM(RCBILL),$$SL1(RCSORT,RCBILL),RCBILL,+RCEOB(RCEOB),RCEOB)=""
32 . I $O(RCEOB(0)) S ^TMP($J,"RCSORT",$$INSNM(RCBILL),$$SL1(RCSORT,RCBILL),RCBILL)=RCTOT
33 ;
34 S RCZ="",(RCPG,RCSTOP,RCNEW)=0
35 F S RCZ=$O(^TMP($J,"RCSORT",RCZ)) Q:RCZ=""!RCSTOP S RCZ0="" S:$G(RCINS)="R"!($G(RCINS)="S") RCNEW=1 D
36 . I RCSORT'["-" D
37 .. S RCZ0="" F S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0)) Q:RCZ0=""!RCSTOP D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,.RCPG,RCNEW) S RCNEW=0
38 . I RCSORT["-" D
39 .. S RCZ0="" F S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0),-1) Q:RCZ0=""!RCSTOP D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,.RCPG,.RCNEW) S RCNEW=0
40 ;
41 I 'RCSTOP,RCPG D ASK(.RCSTOP)
42 ;
43ENOUT I $D(ZTQUEUED) S ZTREQ="@"
44 I '$D(ZTQUEUED) D ^%ZISC
45 K ^TMP($J,"RCSORT")
46 Q
47 ;
48OUTPUT(RCZ,RCZ0,RCSORT,RCSTOP,RCINS,RCPG,RCNEW) ; Output the data
49 ; RCZ, RCZ0 are the first 2 sort levels for the array
50 ; RCINS = insurance co info array
51 ; RCSTOP passed by ref - returned if user chooses to stop
52 ; RCNEW = 1 if the header should be forced to print
53 N RCZ1,RCBILL,RC399,RCPT,RC430,RC0,RCEOB,X,Y
54 S RCBILL=0 F S RCBILL=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL)) Q:'RCBILL!RCSTOP S RCZ1="" F S RCZ1=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1)) Q:RCZ1=""!RCSTOP D
55 . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q
56 . S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) S RCNEW=0
57 . Q:RCSTOP
58 . S RC399=$G(^DGCR(399,RCBILL,0)),RCPT=+$P(RC399,U,2),RC430=$G(^PRCA(430,RCBILL,0))
59 . S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) Q:RCSTOP
60 . S X=$$GET1^DIQ(430,RCBILL_",",11)
61 . W !,$E($P(RC399,U)_$J("",8),1,8)_" "_$E($P($G(^DPT(RCPT,0)),U)_$J("",25),1,25)_" "_$E($P($G(^DPT(RCPT,0)),U,9)_$J("",10),1,10)_" ",$E($$INSNM(RCBILL)_$J("",30),1,30)
62 . W !,$J("",8)_$E($J(+$P(RC430,U,3),"",2)_$J("",13),1,13)_" "_$E($J(+$G(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL)),"",2)_$J("",13),1,13)_" "_$E($J(+X,"",2)_$J("",12),1,12)
63 . I $P($G(^PRCA(430,RCBILL,6)),U,4) W " "_$$FMTE^XLFDT($P(^PRCA(430,RCBILL,6),U,4),2)
64 . S RCEOB=0 F S RCEOB=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB)) Q:'RCEOB!RCSTOP D
65 .. S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW)
66 .. Q:RCSTOP
67 .. S RC0=$G(^IBM(361.1,RCEOB,0))
68 .. S RCSTOP=$$NEWPG(.RCPG,.RCINS,RCNEW) Q:RCSTOP
69 .. W !,?10,$E($P(RC0,U,7)_$J("",27),1,27)_" "_$E($$FMTE^XLFDT($P(RC0,U,5),"2D")_$J("",8),1,8)_" "_$E($$FMTE^XLFDT($P(RC0,U,6),"2D")_$J("",8),1,8)_" "_$E($S(RCZ1:$$FMTE^XLFDT(RCZ1,"2D"),1:"")_$J("",8),1,8)
70 .. W " "_$J(+$G(^IBM(361.1,RCEOB,1)),"",2)
71 ;
72 Q
73 ;
74INCLUDE(RCINS,RCZ) ; Function returns 1 if record should be included based
75 ; on ins co
76 ; RCINS = array containing insurance co information
77 ; RCZ = ien of the entry in file 430
78 N OK,RCI,RCINM
79 S OK=0
80 S RCI=+$$INS(RCZ)
81 ;
82 I 'RCI G INCQ ; Not a third party bill
83 ;
84 I RCINS="A" S OK=1
85 ;
86 I RCINS="S"!(RCINS="R") D
87 . I RCINS="S" S:$D(RCINS("S",RCI)) OK=1 Q
88 . S RCINM=$$INSNM(RCZ) ; INS CO NAME
89 . I $S(RCINM=RCINS("FR")!(RCINM]RCINS("FR")):RCINM']RCINS("TO"),1:0) S OK=1
90 ;
91INCQ Q OK
92 ;
93INSNM(RCZ) ; Returns the name of the insurance co for bill ien RCZ file 430
94 N NM
95 S NM=$P($G(^DIC(36,+$$INS(RCZ),0)),U)
96 Q NM
97 ;
98INS(RCZ) ; Returns ien of insurance co for bill ien RCZ from file 430
99 N RC
100 S RC=$P($G(^PRCA(430,RCZ,0)),U,9) ;DEBTOR
101 Q $S($P($G(^RCD(340,+RC,0)),U)'["DIC(36":"",1:+^(0))
102 ;
103NEWPG(RCPG,RCINS,RCNEW) ; Check for new page needed, output header
104 ; RCINS = ins co selection criteria
105 ; RCNEW = 1 to force new page
106 ; Function returns 1 if user chooses to stop output
107 I RCNEW!'RCPG!(($Y+5)>IOSL) D
108 . D:RCPG ASK(.RCSTOP) I RCSTOP Q
109 . D HDR(.RCPG,.RCINS)
110 Q RCSTOP
111 ;
112EEOB(RCZ,RCEOB) ; Find all non-MRA EEOBs for bill ien RCZ
113 ; Function returns 1 if any valid EEOBs found, 0 if none
114 ; RCEOB(eob ien)=date posted returned for valid EEOBs found -
115 ; pass by reference
116 N OK,Z
117 K RCEOB
118 ;
119 S OK=0
120 S Z=0 F S Z=$O(^IBM(361.1,"B",RCZ,Z)) Q:'Z I $P($G(^IBM(361.1,Z,0)),U,4)'=1 D
121 . N Z0,Z1,Z00
122 . S Z0=+$O(^RCY(344.4,"ADET",Z,0)) ; ERA entry received in
123 . S Z1=+$P($G(^RCY(344.4,Z0,0)),U,8) ; Receipt
124 . S Z00=$P($G(^RCY(344.4,Z0,0)),U,14)
125 . I Z1,$S(Z00=1!(Z00=2):1,1:0) S RCEOB(Z)=+$P($G(^RCY(344,Z1,0)),U,8),OK=1
126 ;
127 Q OK
128 ;
129SL1(RCSORT,RCZ) ; Function returns 1st sort level data from ien RCZ in file 430
130 ; RCSORT = "PN" for patient name sort = "L4" for SSN last 4 sort
131 N DAT
132 I RCSORT="PN" S DAT=$P($G(^DPT(+$P($G(^PRCA(430,RCZ,0)),U,7),0)),U)
133 I RCSORT="L4" S DAT=$P($G(^DPT(+$P($G(^PRCA(430,RCZ,0)),U,7),0)),U,9),DAT=$E(DAT,$L(DAT)-3,$L(DAT))
134 Q $S($G(DAT)'="":DAT,1:" ")
135 ;
136SELECT(RCINS,RCSORT) ; Select insurance co and sort criteria
137 ; Function returns values selected for RCSORT and RCINS - passed by ref
138 N RCQUIT,DONE,DIR,X,Y
139 S (RCQUIT,DONE)=0
140 S DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE",DIR("A")="RUN REPORT FOR (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: ",DIR("B")="ALL" W ! D ^DIR K DIR
141 I $D(DTOUT)!$D(DUOUT) G SELQ
142 ;
143 S RCINS=Y
144 I RCINS="S" D G:RCQUIT SELQ
145 . W !
146 . F D LIST(.DIR,.RCINS) S DIR("A")="SELECT "_$S($O(RCINS("S",0)):"ANOTHER ",1:"")_"INSURANCE COMPANY"_$S($O(RCINS("S",0)):" (PRESS RETURN WHEN DONE)",1:"")_": ",DIR(0)="PAO^DIC(36,:AEMQ" D ^DIR K DIR D Q:Y'>0
147 .. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
148 .. I Y>0 S RCINS("S",+Y)=""
149 . I '$O(RCINS("S",0)) S RCQUIT=1 W !!,"NO INSURANCE COMPANIES SELECTED - NO REPORT GENERATED" S DIR(0)="E" D ^DIR K DIR
150 ;
151 I RCINS="R" D I RCQUIT W !!,"NO INSURANCE COMPANY NAME RANGE SELECTED - NO REPORT GENERATED" S DIR(0)="E" D ^DIR K DIR G SELQ
152 . W !
153 . S DIR("?")="ENTER 1-30 UPPERCASE CHARACTERS OF THE FIRST NAME TO INCLUDE"
154 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="START WITH INSURANCE COMPANY NAME: " D ^DIR K DIR
155 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
156 . S RCINS("FR")=Y
157 . S DIR("?")="ENTER 1-30 UPPERCASE CHARACTERS OF THE LAST NAME TO INCLUDE"
158 . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="GO TO INSURANCE COMPANY NAME: ",DIR("B")=$E(RCINS("FR"),1,27)_"ZZZ"
159 . F W ! D ^DIR Q:$S($D(DTOUT)!$D(DUOUT):1,1:RCINS("FR")']Y) W !,"'GO TO' NAME MUST COME AFTER 'START WITH' NAME"
160 . K DIR
161 . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
162 . S RCINS("TO")=Y
163 S DIR(0)="SA^P:PATIENT NAME;L:LAST 4 OF PATIENT SSN",DIR("A")="WITHIN INS CO, SORT BY (P)ATIENT NAME OR (L)AST 4 OF SSN?: ",DIR("B")="PATIENT NAME" W ! D ^DIR K DIR
164 I $D(DTOUT)!$D(DUOUT) G SELQ
165 S RCSORT=$S(Y="P":"PN",1:"L4")
166 S DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST",DIR("A")="SORT "_$S(RCSORT="PN":"PATIENT NAME",1:"LAST 4")_" (F)IRST TO LAST OR (L)AST TO FIRST?: ",DIR("B")="FIRST TO LAST" D ^DIR K DIR
167 I $D(DTOUT)!$D(DUOUT) G SELQ
168 I Y="L" S RCSORT=RCSORT_";-"
169 S DONE=1
170 ;
171SELQ Q DONE
172 ;
173LIST(DIR,RCINS) ; Sets up help array for ins co selected in DIR("?")
174 N CT,Z
175 S CT=1
176 I '$O(RCINS("S",0)) S DIR("?")="NO INSURANCE COMPANIES SELECTED" Q
177 S DIR("?",1)="INSURANCE COMPANIES ALREADY SELECTED:"
178 S Z=0 F S Z=$O(RCINS("S",Z)) Q:'Z S CT=CT+1,DIR("?",CT)=" "_$P($G(^DIC(36,Z,0)),U)
179 S DIR("?")=" "
180 Q
181 ;
182HDR(RCPG,RCINS) ;Print report hdr
183 ; RCPG = last page #
184 N Z,Z0,X
185 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
186 S RCPG=$G(RCPG)+1
187 W !,?5,"EDI LOCKBOX ACTIVE BILLS W/EEOB REPORT",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG
188 W !!,"INSURANCE SELECTED: "_$S(RCINS="A":"ALL",RCINS="R":"RANGE FROM "_RCINS("FR")_"-"_RCINS("TO"),1:"")
189 S Z0=""
190 I RCINS="S" S Z=0,Z0="" F S Z=$O(RCINS("S",Z)) Q:'Z S X=$P($G(^DIC(36,Z,0)),U) D
191 . I $L(Z0)+$L(X)>79 W Z0 S Z0="" W !
192 . S Z0=Z0_$S(Z0'="":",",1:"")_X
193 I Z0'="" W Z0
194 W !!,"BILL # PATIENT NAME SSN INS CO NAME"
195 W !," AMOUNT BILLED AMOUNT PAID BALANCE DT REFERRED REG COUNSEL"
196 W !!,?10,"TRACE #"_$J("",22)_"DT REC'D DT PAID DT POST AMOUNT PAID"
197 W !,$TR($J("",IOM)," ","=")
198 Q
199 ;
200ASK(RCSTOP) ;
201 I $E(IOST,1,2)'["C-" Q
202 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
203 S DIR(0)="E" W ! D ^DIR
204 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
205 Q
206 ;
Note: See TracBrowser for help on using the repository browser.