source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEDS.m@ 703

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1RCDPEDS ;ALB/TMK - Display EEOB detail from receipt ;15 Oct 02
2 ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; IA for call to GETEOB^IBCECSA6 = 4044
5 ;
6DISP(RCTDA) ; Display EEOB detail/raw data from file 344.4
7 ; RCTDA = ien of entry in file 344.4 to display
8 ; Returns global ^TMP("$J,"RCDISP")
9 ;
10 N RCZ,RCZ0,RCCT
11 K ^TMP($J,"RCDISP")
12 S RCCT=0
13 ;
14 D SUM(RCTDA,.RCCT)
15 ;
16 S RCZ=0 F S RCZ=$O(^RCY(344.4,RCTDA,1,RCZ)) Q:'RCZ S RCZ0=$G(^(RCZ,0)) I RCZ0'="" D SEQ(RCTDA,.RCCT,RCZ,RCZ0)
17 ;
18 Q
19 ;
20SEQ(RCTDA,RCCT,RC34441,RC0) ;
21 ; RCTDA = ien of record in file 344.4
22 ; RCCT = line counter, updated if passed by ref
23 ; RC34441 = ien of seq # in file 344.41
24 ; RC0 = the data on the 0-node of the sequence entry in file 344.41
25 ;
26 N RCIEN,RCZ,RCDPDATA
27 I $P(RC0,U,2) D ; Get detail from EOB file
28 . K ^TMP("PRCA_EOB",$J)
29 . S RCIEN=+$P(RC0,U,2)
30 . D GETEOB^IBCECSA6(RCIEN,1) ; IA 4044
31 . I $O(^IBM(361.1,RCIEN,"ERR",0)) D ; Add error msgs
32 .. D GETERR(RCIEN,+$O(^TMP("PRCA_EOB",$J,RCIEN," "),-1))
33 . D SEQHDR(RCTDA,RC34441,.RCCT)
34 . S RCZ=0
35 . F S RCZ=$O(^TMP("PRCA_EOB",$J,RCIEN,RCZ)) Q:'RCZ S RCCT=RCCT+1 S ^TMP($J,"RCDISP",RCCT)=$G(^TMP("PRCA_EOB",$J,RCIEN,RCZ))
36 ;
37 I '$P(RC0,U,2),$O(^RCY(344.4,RCTDA,1,RC34441,1,0)) D ; Get detail from raw data in file 344.411
38 . K ^TMP($J,"RCOUT"),^TMP($J,"RCRAW")
39 . D SEQHDR(RCTDA,RC34441,.RCCT)
40 . D DISP^RCDPESR0("^RCY(344.4,"_RCTDA_",1,"_RC34441_",1)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75,1)
41 . K ^TMP($J,"RCRAW")
42 . S RCZ=0
43 . F S RCZ=$O(^TMP($J,"RCOUT",RCZ)) Q:'RCZ S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$G(^TMP($J,"RCOUT",RCZ))
44 K ^TMP($J,"RCOUT"),^TMP("PRCA_EOB",$J)
45 Q
46 ;
47SEQHDR(RCTDA,RC34441,RCCT) ; Extract header data from sequence record
48 ; RCTDA = ien of record in file 344.4
49 ; RC34441 = ien of seq # in file 344.41
50 ; RCCT = line counter, updated if passed by ref
51 ; Returns line # incremented and ^TMP($J,"RCDISP" array
52 ;
53 N RCDPDATA,RCINV
54 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=" "
55 D DIQ34441(RCTDA,RC34441,".01:.15")
56 S RCCT=RCCT+1
57 S RCINV=($G(RCDPDATA(344.41,RC34441,.02,"E"))="")
58 S ^TMP($J,"RCDISP",RCCT)=$E("Sequence #: "_$G(RCDPDATA(344.41,RC34441,.01,"E"))_$S(RCINV:" (Not Stored in IB)",1:"")_$J("",32),1,32)
59 S ^TMP($J,"RCDISP",RCCT)=^TMP($J,"RCDISP",RCCT)_"Bill Number: "_$S('RCINV:RCDPDATA(344.41,RC34441,.02,"E"),1:$G(RCDPDATA(344.41,RC34441,.05,"E"))_" (Not in AR)")
60 I $G(RCDPDATA(344.41,RC34441,.14,"E"))="YES" S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=" *** REVERSAL ***"
61 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("Amount "_$S($G(RCDPDATA(344.41,RC34441,.14,"E"))="YES":"Reversed",1:"Paid")_": "_$G(RCDPDATA(344.41,RC34441,.03,"E"))_$J("",32),1,32)_"Ins Co: "_$E($G(RCDPDATA(344.41,RC34441,.04,"E")),1,30)
62 I $G(RCDPDATA(344.41,RC34441,.07,"E"))'="" S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="Error: "_RCDPDATA(344.41,RC34441,.07,"E")_$S($G(RCDPDATA(344.41,RC34441,.08,"E"))'="":" - "_$G(RCDPDATA(344.41,RC34441,.08,"E")),1:"")
63 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="Worklist Status: "_$G(RCDPDATA(344.41,RC34441,.06,"E"))
64 Q
65 ;
66GETERR(RCIEN,Z) ; Extract error messages from entry RCIEN in file 361.1
67 ; Z = the last line # in the ^TMP("PRCA_EOB",$J,RCIEN,n array
68 ; Function returns error lines from file #361.1 in the
69 ; ^TMP("PRCA_EOB",$J,RCIEN,n array in subscripts at the end of the
70 ; array
71 N Z0,DATA,RCRAW,RCFORM,RCLINE,X
72 S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)="EEOB FILING ERRORS:"
73 S Z0=0 F S Z0=$O(^IBM(361.1,RCIEN,"ERR",Z0)) Q:'Z0 S X=$G(^(Z0,0)) D
74 . I +X S RCLINE=+X_"^RCDPESR9" I $T(@RCLINE)'="" D Q
75 .. S RCRAW(1,0)=X
76 .. D DISP^RCDPESR0("RCRAW","RCFORM",1,"RCDATA",80,0)
77 .. S X=0 F S X=$O(RCFORM(X)) Q:'X S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)=" "_RCFORM(X)
78 . S Z=Z+1,^TMP("PRCA_EOB",$J,RCIEN,Z)=" "_$G(^IBM(361.1,RCIEN,"ERR",Z0,0))
79 Q
80 ;
81SUM(RCTDA,RCCT) ; Extract pertinent top-level data
82 ; RCTDA = ien of record in file 344.4
83 ; RCCT = line counter, updated if passed by ref
84 ;
85 N Z,Z0,CT,CT1,RCDPDATA,RCADJ,RCREV
86 D DIQ3444(RCTDA,".02:.11")
87 S (Z,CT,RCADJ)=0 F S Z=$O(^RCY(344.4,RCTDA,2,Z)) Q:'Z S CT=CT+1,RCADJ=RCADJ+$J($P($G(^(Z,0)),U,3),0,2)
88 S (Z,CT1,RCREV)=0 S Z=0 F S Z0=$O(^RCY(344.4,RCTDA,1,"ATB",1,Z)) Q:'Z S Z0=$G(^RCY(344.4,RCTDA,1,Z,0)),CT1=CT1+1,RCREV(Z)=$$BILLREF^RCDPESR0(RCTDA,Z)_U_$J($P(Z0,U,3),0,2),RCREV=RCREV+$P(RCREV(Z),U,2)
89 S RCCT=RCCT+1,Z="There is data for "_+$G(RCDPDATA(344.4,RCTDA,.11,"E"))_" EEOBs"_$S(CT:", "_CT_" ERA adjustments",1:"")_$S(CT1:", "_CT1_" EEOB reversals",1:"")
90 S ^TMP($J,"RCDISP",RCCT)=$J("",(80-$L(Z))\2)_Z
91 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT PAID: "_+$G(RCDPDATA(344.4,RCTDA,.05,"E"))
92 I RCADJ D
93 . S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT ERA ADJUSTED: "_RCADJ
94 . D DISPADJ^RCDPESR8(RCTDA,"RCADJ")
95 . S Z=0 F S Z=$O(RCADJ(Z)) Q:'Z S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=" "_RCADJ(Z)
96 I RCREV D
97 . S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="TOTAL AMT REVERSED: "_RCREV
98 . S Z=0 F S Z=$O(RCREV(Z)) Q:'Z S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E(" BILL REFERENCE: "_$P(RCREV(Z),U)_$J("",30),1,30)_" REVERSAL AMT: "_$P(RCREV,U,2)
99 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("TRACE #: "_$G(RCDPDATA(344.4,RCTDA,.02,"E"))_$J("",35),1,35)_"RECEIPT #: "_$G(RCDPDATA(344.4,RCTDA,.08,"E"))
100 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("INS CO ID: "_$G(RCDPDATA(344.4,RCTDA,.03,"E"))_$J("",35),1,35)_"NAME: "_$E($G(RCDPDATA(344.4,RCTDA,.06,"E")),1,29)
101 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)=$E("ERA DATE: "_$G(RCDPDATA(344.4,RCTDA,.04,"E"))_$J("",35),1,35)_"DATE ERA RECEIVED: "_$G(RCDPDATA(344.4,RCTDA,.07,"E"))
102 S RCCT=RCCT+1,^TMP($J,"RCDISP",RCCT)="EFT MATCH STATUS: "_$G(RCDPDATA(344.4,RCTDA,.09,"E"))
103 Q
104 ;
105DIQ34441(RCTDA,RC0,DR,ARR) ; DIQ call to retrieve data for DR fields in
106 ; file 344.41
107 N %I,D0,D1,DA,DIC,DIQ,DIQ2,YY
108 I $G(ARR)="" S ARR="RCDPDATA"
109 K @ARR@(344.41,RC0)
110 S DA=RC0,DA(1)=RCTDA,DIQ(0)="E",DIC="^RCY(344.4,"_DA(1)_",1,",DIQ=ARR D EN^DIQ1
111 Q
112 ;
113DIQ3444(DA,DR,ARR) ; DIQ call to retrieve data for DR fields in file 344.41
114 N %I,D0,DIC,DIQ,DIQ2,YY
115 I $G(ARR)="" S ARR="RCDPDATA"
116 K @ARR@(344.4,DA)
117 S DIQ(0)="E",DIC="^RCY(344.4,",DIQ=ARR D EN^DIQ1
118 Q
119 ;
Note: See TracBrowser for help on using the repository browser.