source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEX2.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: 3.3 KB
Line 
1RCDPEX2 ;ALB/TMK - ELECTRONIC EOB DETAIL EXCEPTION MAIN LIST TEMPLATE ;24-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 ;
5INIT ; -- set up inital variables
6 S U="^",VALMCNT=0,VALMBG=1
7 D BLD
8 Q
9 ;
10REBLD ; Set up formatted global
11 ;
12BLD ; -- build list of messages from file 344.4
13 N RCBILL,RCSUB,RCSEQ,RCMSG,RCEXC,RCS,RCER,RCDPDATA,RCX,RC0,DA,X,DR,Y
14 K ^TMP("RCDPEX_SUM-EOB",$J),^TMP("RCDPEX_SUM-EOBDX",$J)
15 S (RCMSG,RCSEQ,VALMCNT)=0
16 ;
17 ; Extract from 344.4
18 S RCER=0
19 F S RCER=$O(^RCY(344.4,"AEXC",RCER)) Q:'RCER F S RCMSG=$O(^RCY(344.4,"AEXC",RCER,RCMSG)) Q:'RCMSG D
20 . ;Extract trace #, ins co name/id, ERA Date
21 . S RCSUB=RCMSG_",",DR=".02:.06",DA=RCMSG K DA(1) D DIQ3444(DA,DR)
22 . S RCX("TRACE")=$G(RCDPDATA(344.4,RCSUB,.02,"E"))
23 . S RCX=$$SETSTR^VALM1(" "_$E($G(RCDPDATA(344.4,RCSUB,.06,"E")),1,25)_"/"_$E($G(RCDPDATA(344.4,RCSUB,.03,"E")),1,20),"",22,48)
24 . S RCX=$$SETSTR^VALM1(" "_$$FMTE^XLFDT($G(RCDPDATA(344.4,RCSUB,.04,"I")),2),RCX,70,10)
25 . ;
26 . S RCS=0 F S RCS=$O(^RCY(344.4,"AEXC",RCER,RCMSG,RCS)) Q:'RCS S RC0=$G(^RCY(344.4,RCMSG,1,RCS,0)) D
27 .. S RCSEQ=RCSEQ+1
28 .. S RCX=$$SETSTR^VALM1($E(RCSEQ_$J("",4),1,4)_" "_$G(RCX("TRACE")),RCX,1,21)
29 .. D SET(RCX,RCSEQ,RCMSG,RCS)
30 .. S DA(1)=RCMSG,DA=RCS,RCSUB=DA_","_DA(1)_","
31 .. S DR=".01;.02;.03;.05;.07;.08;.1;.11;.12;.15",DA=RCS D DIQ3444(.DA,DR)
32 .. S X=$$SETSTR^VALM1($J("",6)_"Seq #: "_$G(RCDPDATA(344.41,RCSUB,.01,"E")),"",1,17)
33 .. S RCBILL=$S($G(RCDPDATA(344.41,RCSUB,.02,"E"))'="":RCDPDATA(344.41,RCSUB,.02,"E"),1:"*"_$G(RCDPDATA(344.41,RCSUB,.05,"E")))
34 .. S X=$$SETSTR^VALM1(" Bill: "_RCBILL,X,18,20)
35 .. S X=$$SETSTR^VALM1(" Pt: "_$G(RCDPDATA(344.41,RCSUB,.15,"E")),X,38,25)
36 .. S X=$$SETSTR^VALM1(" Pd: "_$J(+$G(RCDPDATA(344.41,RCSUB,.03,"E")),"",2),X,63,17)
37 .. D SET(X,RCSEQ,RCMSG,RCS)
38 .. I $P(RC0,U,11) D
39 ... S X=$J("",10)_"Transferred To: "_$G(RCDPDATA(344.41,RCSUB,.11,"E"))
40 ... S X=$$SETSTR^VALM1(" On: "_$$FMTE^XLFDT($G(RCDPDATA(344.41,RCSUB,.12,"I")),2),X,$L(X)+1,25)
41 ... D SET(X,RCSEQ,RCMSG,RCS)
42 .. S RCEXC=$S($G(RCDPDATA(344.41,RCSUB,.07,"I"))=99:$S($G(RCDPDATA(344.41,RCSUB,.08,"E"))'="":RCDPDATA(344.41,RCSUB,.08,"E"),1:"UNKNOWN"),1:$G(RCDPDATA(344.41,RCSUB,.07,"E")))
43 .. S X=$J("",10)_"**Exception: "_RCEXC_$S($P(RC0,U,7)=1:$S('$P(RC0,U,11):" (TRANSFER NEEDED IF NOT YOURS)",$P(RC0,U,10)=0:" (TRANSFER REJECTED)",$P(RC0,U,16):" (TRANSFER ACKNOWLEDGED)",1:" (TRANSFER NOT ACKNOWLEDGED)"),1:"")
44 .. D SET(X,RCSEQ,RCMSG,RCS)
45 ;
46 I '$D(^TMP("RCDPEX_SUM-EOB",$J)) S VALMCNT=2,^TMP("RCDPEX_SUM-EOB",$J,1,0)=" ",^TMP("RCDPEX_SUM-EOB",$J,2,0)=" There Are No EEOB Detail Exceptions On File"
47 Q
48 ;
49FNL ; -- Clean up list
50 K ^TMP("RCDPEX_SUM-EOBDX",$J)
51 D CLEAN^VALM10
52 K RCFASTXT
53 Q
54 ;
55SET(X,RCSEQ,RCMSG,RCS) ; -- set arrays for EOB exception records
56 ; X = the data to set into the global
57 S VALMCNT=VALMCNT+1,^TMP("RCDPEX_SUM-EOB",$J,VALMCNT,0)=X
58 S ^TMP("RCDPEX_SUM-EOB",$J,"IDX",VALMCNT,RCSEQ)=""
59 S ^TMP("RCDPEX_SUM-EOBDX",$J,RCSEQ)=VALMCNT_U_RCMSG_U_RCS
60 Q
61 ;
62HDR ;
63 S VALMHDR(1)=$J("",19)_"EEOB DETAIL DATA WITH EXCEPTION CONDITIONS"
64 S VALMHDR(2)=" "
65 Q
66 ;
67DIQ3444(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.4/344.41
68 N %I,D0,DIC,DIQ,DIQ2,YY,FILE
69 S FILE=$S($D(DA(1)):344.41,1:344.4)
70 K RCDPDATA(FILE)
71 D GETS^DIQ(FILE,DA_","_$S($G(DA(1)):DA(1)_",",1:""),DR,"EI","RCDPDATA")
72 Q
73 ;
Note: See TracBrowser for help on using the repository browser.