VistA-WorldVistAEHR/r/ACCOUNTS_RECEIVABLE-PRCA-PR.../RCDPEX2.m

74 lines
3.3 KiB
Mathematica

RCDPEX2 ;ALB/TMK - ELECTRONIC EOB DETAIL EXCEPTION MAIN LIST TEMPLATE ;24-OCT-02
;;4.5;Accounts Receivable;**173**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
INIT ; -- set up inital variables
S U="^",VALMCNT=0,VALMBG=1
D BLD
Q
;
REBLD ; Set up formatted global
;
BLD ; -- build list of messages from file 344.4
N RCBILL,RCSUB,RCSEQ,RCMSG,RCEXC,RCS,RCER,RCDPDATA,RCX,RC0,DA,X,DR,Y
K ^TMP("RCDPEX_SUM-EOB",$J),^TMP("RCDPEX_SUM-EOBDX",$J)
S (RCMSG,RCSEQ,VALMCNT)=0
;
; Extract from 344.4
S RCER=0
F S RCER=$O(^RCY(344.4,"AEXC",RCER)) Q:'RCER F S RCMSG=$O(^RCY(344.4,"AEXC",RCER,RCMSG)) Q:'RCMSG D
. ;Extract trace #, ins co name/id, ERA Date
. S RCSUB=RCMSG_",",DR=".02:.06",DA=RCMSG K DA(1) D DIQ3444(DA,DR)
. S RCX("TRACE")=$G(RCDPDATA(344.4,RCSUB,.02,"E"))
. 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)
. S RCX=$$SETSTR^VALM1(" "_$$FMTE^XLFDT($G(RCDPDATA(344.4,RCSUB,.04,"I")),2),RCX,70,10)
. ;
. 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
.. S RCSEQ=RCSEQ+1
.. S RCX=$$SETSTR^VALM1($E(RCSEQ_$J("",4),1,4)_" "_$G(RCX("TRACE")),RCX,1,21)
.. D SET(RCX,RCSEQ,RCMSG,RCS)
.. S DA(1)=RCMSG,DA=RCS,RCSUB=DA_","_DA(1)_","
.. S DR=".01;.02;.03;.05;.07;.08;.1;.11;.12;.15",DA=RCS D DIQ3444(.DA,DR)
.. S X=$$SETSTR^VALM1($J("",6)_"Seq #: "_$G(RCDPDATA(344.41,RCSUB,.01,"E")),"",1,17)
.. S RCBILL=$S($G(RCDPDATA(344.41,RCSUB,.02,"E"))'="":RCDPDATA(344.41,RCSUB,.02,"E"),1:"*"_$G(RCDPDATA(344.41,RCSUB,.05,"E")))
.. S X=$$SETSTR^VALM1(" Bill: "_RCBILL,X,18,20)
.. S X=$$SETSTR^VALM1(" Pt: "_$G(RCDPDATA(344.41,RCSUB,.15,"E")),X,38,25)
.. S X=$$SETSTR^VALM1(" Pd: "_$J(+$G(RCDPDATA(344.41,RCSUB,.03,"E")),"",2),X,63,17)
.. D SET(X,RCSEQ,RCMSG,RCS)
.. I $P(RC0,U,11) D
... S X=$J("",10)_"Transferred To: "_$G(RCDPDATA(344.41,RCSUB,.11,"E"))
... S X=$$SETSTR^VALM1(" On: "_$$FMTE^XLFDT($G(RCDPDATA(344.41,RCSUB,.12,"I")),2),X,$L(X)+1,25)
... D SET(X,RCSEQ,RCMSG,RCS)
.. 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")))
.. 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:"")
.. D SET(X,RCSEQ,RCMSG,RCS)
;
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"
Q
;
FNL ; -- Clean up list
K ^TMP("RCDPEX_SUM-EOBDX",$J)
D CLEAN^VALM10
K RCFASTXT
Q
;
SET(X,RCSEQ,RCMSG,RCS) ; -- set arrays for EOB exception records
; X = the data to set into the global
S VALMCNT=VALMCNT+1,^TMP("RCDPEX_SUM-EOB",$J,VALMCNT,0)=X
S ^TMP("RCDPEX_SUM-EOB",$J,"IDX",VALMCNT,RCSEQ)=""
S ^TMP("RCDPEX_SUM-EOBDX",$J,RCSEQ)=VALMCNT_U_RCMSG_U_RCS
Q
;
HDR ;
S VALMHDR(1)=$J("",19)_"EEOB DETAIL DATA WITH EXCEPTION CONDITIONS"
S VALMHDR(2)=" "
Q
;
DIQ3444(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.4/344.41
N %I,D0,DIC,DIQ,DIQ2,YY,FILE
S FILE=$S($D(DA(1)):344.41,1:344.4)
K RCDPDATA(FILE)
D GETS^DIQ(FILE,DA_","_$S($G(DA(1)):DA(1)_",",1:""),DR,"EI","RCDPDATA")
Q
;