source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEWL1.m

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1RCDPEWL1 ;ALB/TMK - ELECTRONIC EOB WORKLIST SCREEN ;26-NOV-02
2 ;;4.5;Accounts Receivable;**173,208,222**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; IA for read access to ^IBM(361.1 = 4051
5 ; IA for call to ^DGENA = 3812
6 Q
7 ;
8BLD(RCSORT) ; Build the detail display record for the WL scratch pad record
9 ; Assume RCSCR = ien from file 344.49
10 ; RCSORT = "" or 'N' for no sort 'F' for 0-pays first, 'L' for last
11 ;
12 N A,A0,B,B0,Q,Q0,Q1,QQ,V1,X,Y,Z,Z0,Z3,ZZ,ZZ1,RCT,RCZ,RCZ0,RCZZ0,RCSA,RCAZ,RCAZ0,RCSCT,RCS1,RCLI1,RCY34441,RCZERO,RCTS,RCTL
13 S RCSORT=$P($G(RCSORT),U),RCSORT=$S(RCSORT="":"N",1:RCSORT),RCTS=0
14 K ^TMP("RCDPE-EOB_WL",$J),^TMP("RCDPE-EOB_WLDX",$J),^TMP($J,"RCS"),^TMP("RC_BILL",$J)
15 ;
16 S VALMCNT=0
17 S Z=0 F S Z=$O(^RCY(344.49,RCSCR,1,"B",Z)) Q:'Z I Z#1=0 S ZZ=+$O(^RCY(344.49,RCSCR,1,"B",Z,0)) I ZZ D
18 . S RCZ=ZZ,RCZ0=$G(^RCY(344.49,RCSCR,1,ZZ,0)),RCS1=$P(RCZ0,U,6)
19 . Q:$S('$G(^TMP("RCBATCH_SELECTED",$J)):0,1:$P(RCZ0,U,14)'=+^TMP("RCBATCH_SELECTED",$J)) ; Must be entire ERA or match the selected batch to continue
20 . S RCZERO=$S($P(RCZ0,U,2)["**ADJ":"-1",RCSORT="N":1,RCSORT="F":+RCS1'=0,1:+RCS1=0)
21 . ;
22 . ; This is a top-level entry - find the sublines
23 . S Z0=Z F S Z0=$O(^RCY(344.49,RCSCR,1,"B",Z0)) Q:((Z0\1)'=(Z\1)) S Z=Z0,ZZ1=+$O(^RCY(344.49,RCSCR,1,"B",Z0,0)) I ZZ1 D
24 .. S ^TMP($J,"RCS",RCZERO,ZZ,ZZ1)=""
25 . S ^TMP($J,"RCS",RCZERO,ZZ)=""
26 ;
27 S RCZERO="",RCTS=0 F S RCZERO=$O(^TMP($J,"RCS",RCZERO)) Q:RCZERO="" S ZZ=0 F S ZZ=$O(^TMP($J,"RCS",RCZERO,ZZ)) Q:'ZZ D
28 . N A
29 . S RCZ0=$G(^RCY(344.49,RCSCR,1,ZZ,0)),RCS1=$P(RCZ0,U,6),RCTS=RCTS+1,RCY34441=$G(^RCY(344.4,RCSCR,1,+$P(RCZ0,U,9),0))
30 . S A=$$TOPLINE(RCZ0,RCTS)
31 . D SET(A,RCTS,RCTS,ZZ)
32 . I $P(RCY34441,U,11) D
33 .. D SET("EEOB TRANSFERRED TO "_$E($P($G(^DIC(4,+$P(RCY34441,U,11),0)),U),1,20)_" "_$$FMTE^XLFDT($P(RCY34441,U,12),"2D")_" STATUS: "_$$EXTERNAL^DILFD(344.41,.1,"",+$P(RCY34441,U,10)),RCTS,RCTS,ZZ)
34 . ;
35 . S RCT=RCTS
36 . S ZZ1=0 F S ZZ1=$O(^TMP($J,"RCS",RCZERO,ZZ,ZZ1)) Q:'ZZ1 D
37 .. S RCT=RCT+.001
38 .. S RCTL=$L(RCT)
39 .. S RCZZ0=$G(^RCY(344.49,RCSCR,1,ZZ1,0))
40 .. S V1=$S($P(RCZ0,U,2)'["**ADJ":"",$P($P(RCZ0,U,2),"ADJ",2):"***ADJUSTMENT AT ERA LEVEL",1:"*** ADJUSTMENT LINE FOR TOTALS MISMATCH")
41 .. S RCLI1=$S(V1="":" Claim #: "_$P(RCZZ0,U,2)_" Patient/Last 4: "_$S($P(RCZZ0,U,7):$$PNM4("","",$P(RCZZ0,U,7)),'$P($G(^RCY(344.49,RCSCR,1,ZZ1,2)),U,3):$$PNM4(+$G(^RCY(344.49,RCSCR,0)),RCZ),1:"??"),1:V1)
42 .. D SET($J("",4)_$P(" ^(V)",U,$P(RCZZ0,U,13)+1)_RCT_RCLI1,RCTS,RCT,ZZ1)
43 .. I '$P(RCZZ0,U,7),$P(RCZ0,U,2)'["**ADJ" D SET($J("",4+RCTL)_"***CLAIM NOT FOUND IN YOUR AR ***",RCTS,RCT,ZZ1)
44 .. I $P(RCZZ0,U,7) D
45 ... N A,RCX,Q
46 ... S A("OA")=$$ORI^PRCAFN(+$P(RCZZ0,U,7)),A("SDT")=$P($G(^DGCR(399,+$P(RCZZ0,U,7),"U")),U),A("DFN")=+$P($G(^(0)),U,2),A("ENRPR")=""
47 ... ; Find Rx copay status
48 ... S A("RXCP")=$S('A("SDT"):"",1:$$RXST^IBARXEU(A("DFN"),A("SDT"))),A("RXCP")=$S($P(A("RXCP"),U)'="":$P(A("RXCP"),U,2),1:"UNKNOWN") ;IA #10147
49 ... ; Find M/T status
50 ... S RCX=$$LST^DGMTU(A("DFN"),A("SDT")),A("M/T")=$P(RCX,U,4)
51 ... S A("M/T")=$S('RCX:"??",A("M/T")="P":"PEN",A("M/T")="C":"YES",A("M/T")="G":"GMT",A("M/T")="R":"REQ",1:"NO")
52 ... ;
53 ... S QQ=" Billed Amt: "_$J(A("OA"),"",2)_" Amt To Post: "_$J(+$P(RCZZ0,U,3),"",2)
54 ... D SET($J("",4+RCTL)_"Claim Bal: "_$J(+$P($$BILL^RCJIBFN2(+$P(RCZZ0,U,7)),U,3),"",2)_QQ,RCTS,RCT,ZZ1)
55 ... S ^TMP("RC_BILL",$J,$P(RCZZ0,U,7),RCT)=QQ
56 ... S Z3=$J("",4+RCTL)_"Svc Dt: "_$S(A("SDT")'="":$$FMTE^XLFDT(A("SDT"),2),1:"UNKNOWN")
57 ... S Z3=Z3_" COB: "_$S($D(^DGCR(399,+$P(RCZZ0,U,7),"I"_($$COBN(+$P(RCZZ0,U,7))+1))):"YES",1:"NO ")
58 ... D SET(Z3_" Rx Copay: "_$E(A("RXCP"),1,17)_" Means Tst: "_A("M/T"),RCTS,RCT,ZZ1)
59 .. ;
60 .. D SET($J("",4+RCTL)_"Payment Amt: "_$J(+$P(RCZZ0,U,5),"",2)_" Total Adjustments: "_$J(+$P(RCZZ0,U,8),"",2)_" Net: "_$J($P(RCZZ0,U,5)+$P(RCZZ0,U,8),"",2),RCTS,RCT,ZZ1)
61 .. I $P(RCZZ0,U,10)'="" D SET($J("",9)_"Receipt Comment: "_$P(RCZZ0,U,10),RCTS,RCT,ZZ1)
62 .. I $O(^RCY(344.49,RCSCR,1,ZZ1,1,0)) D
63 ... S Z3=""
64 ... D SET($J("",4+RCTL)_"ADJUSTMENTS:",RCTS,RCT,ZZ1)
65 ... S RCAZ=0 F S RCAZ=$O(^RCY(344.49,RCSCR,1,ZZ1,1,RCAZ)) Q:'RCAZ S RCAZ0=$G(^(RCAZ,0)) D
66 .... S Z3=$J("",6+RCTL)_+RCAZ0_". ",Q=$L(Z3)
67 .... ;
68 .... I $P(RCAZ0,U,2)=0 S Z3=Z3_"Distributed adj dec for retraction "_$P(RCAZ0,U,4)_": "_$P(RCAZ0,U,3)
69 .... I $P(RCAZ0,U,2)=1 S Z3=Z3_"Adjustment distribution to balance receipt: "_$P(RCAZ0,U,3)
70 .... ;
71 .... I $P(RCAZ0,U,2)=2!($P(RCAZ0,U,2)=4) D
72 ..... S Z3=Z3_"ERA payment adjusted from "_$J($P(RCZZ0,U,5)-$P(RCZZ0,U,6),"",2)_" to "_$J(+$P(RCZZ0,U,5),"",2)_" NET: "_$J($P(RCZZ0,U,5)+$P(RCAZ0,U,3),"",2)
73 .... I $P(RCAZ0,U,2)=5 S Z3=Z3_"Non-specific payment (ref# "_$P(RCAZ0,U,4)_"): "_$P(RCAZ0,U,3)
74 .... I $P(RCAZ0,U,2)=3 S Z3=Z3_"Non-specific retraction (ref# "_$P(RCAZ0,U,4)_"): "_$P(RCAZ0,U,3)
75 .... D SET(Z3,RCTS,RCT,ZZ1)
76 .... I $P(RCAZ0,U,9)'="" D SET($J("",Q)_$P(RCAZ0,U,9),RCTS,RCT,ZZ1)
77 .. ;
78 .. I $P($G(^TMP($J,"RC_SORTPARM")),U,2) D
79 ... S A=$J("",10)_"REVIEW STATUS: ("_$S($P(RCZ0,U,11)="I":"REVIEW IN PROCESS",$P(RCZ0,U,11)=1:"REVIEWED",1:"NOT REVIEWED")
80 ... I $P(RCZ0,U,12) S A=A_" SET BY: "_$E($P($G(^VA(200,$P(RCZ0,U,12),0)),U),1,20)
81 ... D SET(A_")",+RCTS,RCT,ZZ1)
82 ... S A=0 F S A=$O(^RCY(344.49,RCSCR,1,ZZ,4,A)) Q:'A S A0=$G(^(A,0)) D
83 .... D SET($J("",12)_$$FMTE^XLFDT($P(A0,U),2)_" "_$P($G(^VA(200,+$P(A0,U,2),0)),U)_$S($P(A0,U,4):" LAST EDIT: "_$$FMTE^XLFDT($P(A0,U,4),2),1:""),RCTS,RCT,ZZ1)
84 .... S B=0 F S B=$O(^RCY(344.49,RCSCR,1,ZZ,4,A,1,B)) Q:'B S B0=$G(^(B,0)) D
85 ..... I $L(B0)>64 D SET($J("",15)_$E(B0,1,64),RCTS,RCT,ZZ1) S B0=" "_$E(B0,65,$L(B0)) ; Split line if > 64 characters in comment line
86 ..... D SET($J("",15)_B0,RCTS,RCT,ZZ1)
87 .. S A="",$P(A,".",79)="" D SET(A,RCTS,RCT,ZZ1)
88 ;
89 I VALMCNT=0,$G(^TMP("RCBATCH_SELECTED",$J)) D SET("THERE ARE NO EEOBs ASSIGNED TO THIS BATCH")
90 K ^TMP($J,"RCS")
91 Q
92 ;
93TOPLINE(RCZ0,RCTS) ; Function returns the top line of the EEOB display
94 ; RCZ0 = the 0-node of the whole number entry line for the EEOB
95 ; RCTS = the selectable line #
96 N A
97 S A=" "_$S($P(RCZ0,U,13):"(V)",1:" ")_"EEOB Seq #"_$S($P(RCZ0,U,9)[",":"'s",1:"")_" On ERA: "_$S($P(RCZ0,U,9)'="":$P(RCZ0,U,9),1:"None")_" Net Payment Amt: "_$J(+$P(RCZ0,U,6),"",2)
98 I $P($G(^TMP($J,"RC_SORTPARM")),U,2) S A=A_" Reviewed?: "_$S($P(RCZ0,U,11)="":"NO",1:$$EXTERNAL^DILFD(344.491,.11,,$P(RCZ0,U,11)))
99 S A=$E(RCTS_$J("",4),1,4)_A
100 Q A
101 ;
102INIT ;
103 S VALMBG=$G(^TMP($J,"RC_VALMBG"))
104 Q
105 ;
106HDR ;
107 D HDR^RCDPEWL
108 Q
109 ;
110FNL ; -- Clean up list
111 K RCFASTXT
112 Q
113 ;
114SET(X,RCSEQ,RCSEQ1,RCZ9) ; -- set arrays
115 ; X = the data to set into the global
116 ; RCSEQ = the selectable line #
117 ; RCSEQ1 = the sub line #
118 ; RCZ9 = reference to the line(s) in file 344.41 or to the subline in
119 ; file 344.49 for RCSEQ having a decimal
120 S VALMCNT=VALMCNT+1,^TMP("RCDPE-EOB_WL",$J,VALMCNT,0)=X
121 I $G(RCSEQ) S ^TMP("RCDPE-EOB_WL",$J,"IDX",VALMCNT,RCSEQ)=""
122 I $G(RCSEQ1),'$D(^TMP("RCDPE-EOB_WLDX",$J,RCSEQ1)) S ^TMP("RCDPE-EOB_WLDX",$J,RCSEQ1)=VALMCNT_U_$G(RCZ9)
123 Q
124 ;
125PNM4(RCIFN,RCDA,RC) ; Returns either the patient name or patient name/last 4
126 ; RCIFN = ien of file 344.4
127 ; RCDA = ien of file 344.41
128 ; RC = the ien of file 430
129 N Z,Z0,Q
130 S Z=""
131 I $G(RCIFN)'="" D
132 . S Z0=$G(^RCY(344.4,RCIFN,1,RCDA,0)),Z=""
133 . I $P(Z0,U,2) S Q=+$P($G(^DGCR(399,+$G(^IBM(361.1,+$P(Z0,U,2),0)),0)),U,2),Z=$P($G(^DPT(Q,0)),U)_"/"_$E($P($G(^(0)),U,9),6,9) ; IA 4051
134 . I $TR(Z,"/")="" S Z=$P(Z0,U,15)
135 I $G(RC)'="" D
136 . S Q=+$P($G(^PRCA(430,RC,0)),U,7)
137 . I Q S Z=$P($G(^DPT(Q,0)),U)_"/"_$E($P($G(^(0)),U,9),6,9)
138 Q Z
139 ;
140COBN(RC,A) ; Return seq # of selected payer
141 ; A = 'PST' or null to get current bill payer seq #
142 I $G(A)="" S A=$P($G(^DGCR(399,RC,0)),U,21) S:A="" A="P" S:"PST"'[A A="P"
143 I 'A S A=$F("PST",A)-1 S:A<1 A=1
144 Q A
145 ;
146COPAY(RCIFN) ; Returns 1 if any not cancelled 1st party bills exist for
147 ; a 3rd party bill or any bills related to this 3rd party bill
148 ; RCIFN = the 3rd party bill #
149 N FIRST,RCTP0,RCTP1,RCTP2
150 K ^TMP("IBRBF",$J),^TMP($J,"IBRBF")
151 D RELBILL^IBRFN(RCIFN) ; DBIA 3124
152 S RCTP0=0 F S RCTP0=$O(^TMP("IBRBF",$J,RCIFN,RCTP0)) Q:RCTP0="" S RCTP1=$G(^(RCTP0)) D
153 . I $P(RCTP1,U,3) K ^TMP("IBRBF",$J,RCIFN,RCTP0) Q ; IB cancelled
154 . S RCTP2=$O(^PRCA(430,"B",+$P(RCTP1,U,4),0)) I $P($G(^PRCA(430,+RCTP2,0)),U,8)=39 K ^TMP("IBRBF",$J,RCIFN,RCTP0) ; AR cancelled
155 S FIRST=$S($O(^TMP("IBRBF",$J,RCIFN,0)):1,1:0)
156 K ^TMP("IBRBF",$J),^TMP($J,"IBRBF")
157 Q FIRST
158 ;
Note: See TracBrowser for help on using the repository browser.