230 lines
8.8 KiB
Mathematica
230 lines
8.8 KiB
Mathematica
RCDPEX3 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;10-OCT-02
|
|
;;4.5;Accounts Receivable;**173,208**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
; IA REF TO ^IBE(350.9 = 4049
|
|
Q
|
|
;
|
|
VP ; View/Print ERA Msgs - File 344.4
|
|
N X,Y,RCDA,RCTDA,RCALL,DIR,POP
|
|
D FULL^VALM1
|
|
S DIR(0)="SA^A:ALL;S:SELECTED",DIR("A")="PRINT (A)LL or (S)ELECTED RECORDS?: "
|
|
S DIR("B")="ALL"
|
|
D ^DIR K DIR
|
|
G:$D(DUOUT)!$D(DTOUT) VPQ
|
|
S RCALL=(Y="A")
|
|
;
|
|
I 'RCALL D G:'$O(RCDA("")) VPQ
|
|
. D SEL(.RCDA)
|
|
;
|
|
; device
|
|
N %ZIS,ZTRTN,ZTSAVE,ZTDESC
|
|
S %ZIS="QM" D ^%ZIS G:POP VPQ
|
|
I $D(IO("Q")) D G VPQ
|
|
. S ZTRTN="VPOUT^RCDPEX3",ZTDESC="AR - Print ERA/EEOB Data With Exceptions"
|
|
. S ZTSAVE("RCDA")="",ZTSAVE("RCALL")="",ZTSAVE("^TMP(""RCDPEX_SUM-EOBDX"",$J,")=""
|
|
. D ^%ZTLOAD
|
|
. W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
|
|
. K ZTSK,IO("Q") D HOME^%ZIS
|
|
U IO
|
|
;
|
|
VPOUT ; Entrypoint queued job
|
|
; RCDA, RCALL must be defined
|
|
N Z,RCSTOP,RCZ,RCPG,RCDOT,RCTDA1
|
|
K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT")
|
|
S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)=""
|
|
I RCALL D
|
|
. S RCZ=0 F S RCZ=$O(^TMP("RCDPEX_SUM-EOBDX",$J,RCZ)) Q:'RCZ S RCTDA=$G(^(RCZ)),RCTDA1=+$P(RCTDA,U,3),RCTDA=+$P(RCTDA,U,2) D Q:RCSTOP
|
|
.. D PRT(RCTDA,RCTDA1,.RCPG,.RCSTOP)
|
|
.. I $O(^TMP("RCDPEX_SUM-EOBDX",$J,RCZ)) D WRTSEP(RCDOT,RCPG)
|
|
I 'RCALL D
|
|
. S RCZ=0 F S RCZ=$O(RCDA(RCZ)) Q:'RCZ D
|
|
.. S RCTDA1=+$P(RCDA(RCZ),U,2),RCTDA=+RCDA(RCZ) D PRT(RCTDA,RCTDA1,.RCPG,.RCSTOP) I $O(RCDA(RCZ)) D WRTSEP(RCDOT,RCPG)
|
|
;
|
|
I '$D(ZTQUEUED),'RCSTOP,RCPG D ASK(.RCSTOP)
|
|
;
|
|
I $D(ZTQUEUED) S ZTREQ="@"
|
|
I '$D(ZTQUEUED) D ^%ZISC
|
|
;
|
|
VPQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT")
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
WRTSEP(RCDOT,RCPG) ; Separating lines if more records to print
|
|
W !,RCDOT,!,RCDOT
|
|
I (($Y+5)>IOSL) D HDR(.RCPG) Q
|
|
W !!
|
|
Q
|
|
;
|
|
PRT(RCTDA,RCTDA1,RCPG,RCSTOP) ; Print data from file 344.4 and 344.41
|
|
; RCTDA = ien file 344.4
|
|
; RCTDA1 = ien file 344.41
|
|
; RCPG = last page extracted
|
|
; RCSTOP = returned 1 if passed by ref and process stopped
|
|
;
|
|
N RCDIQ,RCDIQ1,RCDIQ2,RCXM1,RC,Z
|
|
D GETS^DIQ(344.4,RCTDA_",","*","IEN","RCDIQ")
|
|
D TXT0^RCDPEX31(RCTDA,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned fields
|
|
;
|
|
I $O(^RCY(344.4,RCTDA,2,0)) S RC=RC+1,RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**"
|
|
S Z=0 F S Z=$O(^RCY(344.4,RCTDA,2,Z)) Q:'Z D
|
|
. D GETS^DIQ(344.42,Z_","_RCTDA_",","*","IEN","RCDIQ2")
|
|
. D TXT2^RCDPEX31(RCTDA,Z,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs
|
|
;
|
|
D GETS^DIQ(344.41,RCTDA1_","_RCTDA_",","*","IEN","RCDIQ1")
|
|
D TXT00^RCDPEX31(RCTDA,RCTDA1,.RCDIQ1,.RCXM1,.RC)
|
|
D DISP^RCDPESR0("^RCY(344.4,"_RCTDA_",1,"_RCTDA1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75) ; Get formatted 'raw' data
|
|
;
|
|
I $D(RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2)) D
|
|
. S RC=RC+1,RCXM1(RC)=" **RESOLUTION LOG DATA**"
|
|
. S Z=0 F S Z=$O(RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2,Z)) Q:'Z S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCTDA1_","_RCTDA_",",2,Z)
|
|
. S RC=RC+1,RCXM1(RC)=" "
|
|
S (RCSTOP,Z)=0
|
|
F S Z=$O(RCXM1(Z)) Q:'Z S ^TMP($J,"RC_SUMOUT",Z-999)=RCXM1(Z)
|
|
S Z=""
|
|
F S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z D Q:RCSTOP
|
|
. I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q
|
|
. I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
|
|
.. D:RCPG ASK(.RCSTOP) I RCSTOP Q
|
|
.. D HDR(.RCPG)
|
|
. W !,$G(^TMP($J,"RC_SUMOUT",Z))
|
|
;
|
|
Q
|
|
;
|
|
XFR ; Transfer EOB(s) to other site
|
|
N RC,RC0,RCCHG,RCOK,RCDOMAIN,RCDEF,RCDA,RCWHY,RCER,RCECT,RCXTO,RCALL,RCCONT,DIR,X,Y,DA,DIE,DR,POP,RCDA,RCXDA,RCXDA1,RCDUZ,XMBODY,XMTO
|
|
D FULL^VALM1
|
|
D SEL(.RCDA)
|
|
;
|
|
G:'$O(RCDA(0)) XFRQ
|
|
S DIR("S")="I +$G(^DIC(4,+Y,6))",DIR(0)="PA^4:AME",DIR("A")="TRANSFER TO WHICH SITE?: " D ^DIR K DIR
|
|
I $D(DUOUT)!$D(DTOUT) G XFRQ
|
|
S RCXTO=+Y,RCCHG=0
|
|
;
|
|
S RCDOMAIN=$$EXTERNAL^DILFD(4,60,,+$G(^DIC(4,+RCXTO,6))),RCECT=0
|
|
I RCDOMAIN="" D G XFRQ
|
|
. S DIR("A",1)="THERE IS NO VALID DOMAIN SET UP FOR THIS SITE. YOU MUST CHOOSE ANOTHER ONE.",DIR("A")="PRESS RETURN TO CONTINUE",DIR(0)="EA" W ! D ^DIR K DIR
|
|
;
|
|
S RCDEF=$S($P($G(^IBE(350.9,1,2)),U,6)'="":$E("AGENT CASHIER-"_$P(^IBE(350.9,1,2),U,6),1,45),1:"")
|
|
S DIR("A",1)="ENTER THE CONTACT INFORMATION FOR THE PERSON AT YOUR SITE",DIR("A",2)=" WHO MAY BE CONTACTED BY THE OTHER SITE REGARDING THIS EEOB",DIR("A")=" (1-45 CHARACTERS): "_$S(RCDEF'="":RCDEF_"// ",1:"") ; IA 4049
|
|
S DIR(0)="FA"_$S(RCDEF'="":"O",1:"")_"^1:45" W ! D ^DIR K DIR
|
|
I $D(DUOUT)!$D(DTOUT) G XFRQ
|
|
I Y="" S Y=RCDEF
|
|
S RCCONT=Y
|
|
;
|
|
S DIR(0)="YA",DIR("A")="DO YOU WANT TO PRINT THE EEOB(s)?: ",DIR("B")="Y"
|
|
D ^DIR K DIR
|
|
I $D(DUOUT)!$D(DTOUT) G XFRQ
|
|
I Y=1 S RCER=0 D I RCER G XFRQ
|
|
. N %ZIS,ZTRTN,ZTSAVE,ZTDESC
|
|
. S %ZIS="QM" D ^%ZIS I POP S RCER=1 Q
|
|
. I $D(IO("Q")) D Q
|
|
.. S RCALL=0
|
|
.. S ZTRTN="VPOUT^RCDPEX3",ZTDESC="AR - Print EEOB Data Before Transfer"
|
|
.. S ZTSAVE("RCDA")="",ZTSAVE("RCALL")="",ZTSAVE("^TMP(""RCDPEX_SUM-EOBDX"",$J)")=""
|
|
.. D ^%ZTLOAD
|
|
.. I '$D(ZTSK) S RCER=1
|
|
.. K ZTSK,IO("Q") D HOME^%ZIS
|
|
. S RCALL=0
|
|
. D VPOUT^RCDPEX3
|
|
;
|
|
S RCWHY(1)="Transfer EEOB detail to another site"
|
|
S RC=0 F S RC=$O(RCDA(RC)) Q:'RC D L -^RCY(344.4,RCXDA,1,RCXDA1,0)
|
|
. N RCBODY,RCAMT,RCBILL,RCX,XMZ
|
|
. S RCXDA=+RCDA(RC),RCXDA1=+$P(RCDA(RC),U,2),RCWHY(2)=""
|
|
. I '$$LOCK^RCDPEX31(RCXDA,RCXDA1,1) D Q
|
|
.. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" is being edited by another user - ... please try again later"
|
|
. ;
|
|
. S RC0=$G(^RCY(344.4,RCXDA,1,RCXDA1,0))
|
|
. M RCBODY=^RCY(344.4,RCXDA,1,RCXDA1,1)
|
|
. S RCAMT=$P(RC0,U,3)*100
|
|
. S RCBILL=$P(RC0,U,5)
|
|
. S DIR("A",1)="ONCE THIS EEOB HAS BEEN TRANSFERRED, ITS BILL # CANNOT BE EDITED",DIR("A")="ARE YOU SURE THIS IS NOT A CLAIM FOR YOUR SITE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
|
|
. Q:Y'=1
|
|
. I $P(RC0,U,11) D Q:'RCOK
|
|
.. S RCOK=1
|
|
.. S DIR("A",1)="WARNING: EEOB FOR #"_RC_" ("_RCBILL_") HAS ALREADY BEEN TRANSFERRED",DIR("A",2)=" TO "_$P($G(^DIC(4,+$P(RC0,U,11),0)),U)_" ON: "_$$FMTE^XLFDT($P(RC0,U,12),2)
|
|
.. S DIR("A")="ARE YOU SURE YOU WANT TO TRANSFER IT AGAIN?: "
|
|
.. S DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
|
|
.. I Y=1 Q
|
|
.. S RCOK=0
|
|
.. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" already transferred - "_RCBILL_" NOT transferred again"
|
|
. K RCBODY(0)
|
|
. S RCX=$G(RCBODY(1,0))
|
|
. ;
|
|
. I $P($G(^RCY(344.4,RCXDA,1,RCXDA1,0)),U,7)'=1 D Q
|
|
.. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" is not available for transfer - "_RCBILL_" NOT transferred"
|
|
. ;
|
|
. I $P(RCX,U)'["835ERA"!'$O(RCBODY(1)) D Q
|
|
.. S RCECT=RCECT+1,RCER(RCECT)="**Selection #"_RC_" format is not valid for transfer - "_RCBILL_" NOT transferred"
|
|
. ;
|
|
. S $P(RCX,U)="835XFR",$P(RCX,U,10,16)=(RCAMT_"^^^^^^"_RCCONT)
|
|
. S RCBODY(1,0)=RCX
|
|
. S RCBODY(+$O(RCBODY(""),-1)+1,0)="99^$"
|
|
. S RCBODY(+$O(RCBODY(""),-1)+1,0)="NNNN"
|
|
. S XMTO("S.RCDPE EDI LOCKBOX SERVER@"_RCDOMAIN)=""
|
|
. S XMBODY="RCBODY",RCDUZ=$G(DUZ),DUZ=.5
|
|
. D SENDMSG^XMXAPI(.5,"TRANSFER 3RD PARTY EEOB "_RCBILL_"(REF #"_RCXDA_";"_RCXDA1_"#)",XMBODY,.XMTO,,.XMZ)
|
|
. ;
|
|
. S DUZ=RCDUZ
|
|
. I $G(XMZ) D ; Report msg #
|
|
.. S RCCHG=1
|
|
.. S RCECT=RCECT+1,RCER(RCECT)="Entry #"_RC_" was successfully transferred - msg # is "_XMZ
|
|
.. S DA(1)=RCXDA,DA=RCXDA1,DIE="^RCY(344.4,"_DA(1)_",1,",DR=".09////"_XMZ_";.11////"_RCXTO_";.12////"_$E($$NOW^XLFDT(),1,12) D ^DIE
|
|
.. S RCWHY(2)=" Transfer to "_$P($G(^DIC(4,+RCXTO,0)),U)_" was successful"
|
|
.. ;
|
|
. E D ; error - transfer not done
|
|
.. S RCECT=RCECT+1,RCER(RCECT)="**Entry #"_RC_" was NOT transferred due to a msg build error ("_RCBILL_")"
|
|
.. S RCWHY(2)=" Transfer to "_$P($G(^DIC(4,+RCXTO,0)),U)_" was UNSUCCESSFUL"
|
|
.. ;
|
|
. D STORACT^RCDPEX31(RCXDA,RCXDA1,.RCWHY)
|
|
;
|
|
I $O(RCER(0)) D
|
|
. ; Write msgs
|
|
. W !!,"TRANSFER OF EEOB TO "_$P($G(^DIC(4,RCXTO,0)),U)_" RESULTS: ",!
|
|
. S RCECT=0 F S RCECT=$O(RCER(RCECT)) Q:'RCECT W !," ",RCER(RCECT)
|
|
. W !
|
|
;
|
|
D PAUSE^VALM1
|
|
;
|
|
XFRQ I $G(RCCHG) D BLD^RCDPEX2
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
SEL(RCDA,ONE) ; Select entry(s) from list
|
|
; RCDA = array returned if selections made
|
|
; RCDA(n)=ien of bill selected file 344.4
|
|
; ONE = if set to 1, only one selection can be made at a time
|
|
N RC
|
|
K RCDA
|
|
D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
|
|
S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RC=$G(^TMP("RCDPEX_SUM-EOBDX",$J,RCDA)),RCDA(RCDA)=+$P(RC,U,2)_U_+$P(RC,U,3)
|
|
Q
|
|
;
|
|
HDR(RCPG) ;Print report hdr
|
|
; RCPG = last page #
|
|
I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
|
|
S RCPG=$G(RCPG)+1
|
|
W !,?5,"EDI LOCKBOX EEOB DATA EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=")
|
|
Q
|
|
;
|
|
ASK(RCSTOP) ;
|
|
I $E(IOST,1,2)'["C-" Q
|
|
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
|
S DIR(0)="E" W ! D ^DIR
|
|
I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
|
|
Q
|
|
; ***
|
|
; *** Entrypoints TXT* assume these variable definitions ***
|
|
; ***
|
|
; FUNCTIONs returns RCXM1 and RC if passed by reference
|
|
; RCTDA = ien, file 344.4
|
|
; RCXM1 = array returned with text, captioned
|
|
; RC = # of lines already in array (optional)
|
|
; RCDIQ and RCDIQ1 = arrays returned from GETS^DIQ
|
|
; ***
|
|
;
|
|
UPD ; Try to update the IB EOB file from exception in 344.41
|
|
D UPD^RCDPEX31 ; Moved for space
|
|
Q
|
|
;
|