RCDPEX ;ALB/TMK,DWA - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.5 ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,208,269,298,332**;Mar 20, 1995;Build 40
;Per VA Directive 6402, this routine should not be modified.
Q
;
UPD ; Update (File) ERA msgs manually from EOB exception list for file 344.5
N RCDA,RCOK,RCTDA,ZTSK,RCTSK,RCTYP,RCU,RC0
D FULL^VALM1
D SEL(.RCDA,1)
S RCDA=$O(RCDA(""))
I RCDA="" G UPDQ
S RCTDA=+RCDA(RCDA)
I '$$LOCK(RCTDA) G UPDQ
S RC0=$G(^RCY(344.5,RCTDA,0))
;
I RC0="" D G UPDQ
. W !,*7,"ERA #",RCDA," is no longer in exception file" S RCOK=""
. D PAUSE^VALM1
I $P(RC0,U,5) S RCOK=1 D G:'RCOK UPDQ
. N ZTSK
. S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled
. I "12"[ZTSK(1) W *7,!,"This record has already been scheduled for update. Task # is: ",$P(RC0,U,5) S RCOK="" D PAUSE^VALM1
;
S RCTYP=$P(RC0,U,2)
S RCU=$S(RCTYP="835ERA":"NEWERA^RCDPESR2("_RCTDA_",1)",RCTYP="835XFR":"FILEEOB^RCDPESR5("_RCTDA_")",1:"")
I RCU="" W !,*7,"This message has an invalid 'type' - can't update" D PAUSE^VALM1 G UPDQ
S RCTSK=$$TASK(RCU,RCTDA)
I RCTSK W !,"File update has been tasked (#",RCTSK,")"
I 'RCTSK W !,*7,"File update could not be tasked. Please try again later!!!"
D PAUSE^VALM1
;
D BLD^RCDPEX1("TRANSMISSION")
UPDQ I $G(RCTDA) L -^RCY(344.5,RCTDA,0)
S VALMBCK="R"
Q
;
VP ; View/Print ERA Messages - File 344.5
N DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,RCDA,RCTDA,RCRAW,POP
D FULL^VALM1,SEL(.RCDA,1)
S RCDA=$O(RCDA(""))
G:'RCDA VPQ
S RCTDA=$G(RCDA(RCDA))
S DIR(0)="YA",DIR("A")="DO YOU WANT TO INCLUDE DATA THE WAY IT WAS RECEIVED (RAW DATA)?: ",DIR("B")="N" D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) G VPQ
S RCRAW=+Y
; Ask device
N %ZIS,ZTRTN,ZTSAVE,ZTDESC
S %ZIS="QM" D ^%ZIS G:POP VPQ
I $D(IO("Q")) D G VPQ
. S ZTRTN="VPOUT^RCDPEX",ZTDESC="AR - Print EEOB Exception Message"
. S ZTSAVE("RCTDA")="",ZTSAVE("RCRAW")=""
. 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 for queued job
N Z,Z0,RCSTOP,RCPG,RCXM,RCXM1,RC,RCZ,RCTDAC,RCV5
K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
S RCTDAC=RCTDA_",",RCV5=0
;
D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCZ")
D TXTDE(RCTDA,.RCZ,1,.RCXM,.RC)
;
I $O(^RCY(344.5,RCTDA,"EX",0)) D
. S RC=RC+1,RCXM(RC)="**EXCEPTION MESSAGES**"
. D TXTDE(RCTDA,.RCZ,5,.RCXM,.RC)
;
K ^TMP("RCSAVE",$J)
M ^TMP("RCSAVE",$J)=^RCY(344.5,RCTDA,2)
I +$P($G(^TMP("RCSAVE",$J,1,0)),U,16)>0 S RCV5=1
S Z=0 F S Z=$O(^TMP("RCSAVE",$J,Z)) Q:'Z I $P($G(^(Z,0)),U)["835" K ^(0) Q ; Get rid of header node
D DISP^RCDPESR0("^TMP(""RCSAVE"",$J)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75) ; Get formatted 'raw' data
K ^TMP("RCSAVE",$J)
I $G(RCRAW) D
. S RC=$O(^TMP($J,"RCOUT",""),-1)+1,^TMP($J,"RCOUT",RC)=" "
. S RC=RC+1,^TMP($J,"RCOUT",RC)="**RAW DATA**"
. S Z=0 F S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z D
.. F Z0=1:80:$L($G(^RCY(344.5,RCTDA,2,Z,0))) S RC=RC+1,^TMP($J,"RCOUT",RC)=$E($G(^RCY(344.5,RCTDA,2,Z,0)),Z0,Z0+79)
;
S (RCPG,RCSTOP,Z)=0
F S Z=$O(RCXM(Z)) Q:'Z S ^TMP($J,"RCOUT",Z-999)=RCXM(Z)
S Z=""
F S Z=$O(^TMP($J,"RCOUT",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(RCTDA,.RCPG)
. W !,$G(^TMP($J,"RCOUT",Z))
I 'RCSTOP,RCPG D ASK(.RCSTOP)
;
I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) D ^%ZISC
;
VPQ K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
S VALMBCK="R"
Q
;
SEL(RCDA,ONE) ; Select entry(s) from list
; RCDA = array returned if selections made
; RCDA(n)=ien of bill selected in file 344.5
; 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-EOBDX",$J,RCDA)),RCDA(RCDA)=+$P(RC,U,2)
Q
;
;
DEL ; Delete messages from messages list - file 344.5
N RCDA,RCOK,RCTDA,RCTDAC,RCTYP,RCU,RC0,DIR,RCT,RCE,RCDIQ,RCX,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ,XMZ
D FULL^VALM1
S RCTDA=0
D SEL(.RCDA,1)
S RCDA=$O(RCDA(""))
I RCDA="" G DELQ
S RCTDA=+RCDA(RCDA),RCTDAC=RCTDA_","
S RCPAYTP=$$PAYTYP(RCTDA)
I RCPAYTP="ACH" W !!,"Deletion is not allowed. The ERA has a payment method of ACH." D PAUSE^VALM1 Q
W !
S DIR(0)="YA",DIR("A",1)="This action will PERMANENTLY delete an EDI Lockbox message from your system",DIR("A",2)="A bulletin will be sent to report the deletion",DIR("A",3)=" "
S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
D ^DIR K DIR
G:Y'=1 DELQ
I '$$LOCK(RCTDA) G DELQ
S RC0=$G(^RCY(344.5,RCTDA,0))
;
I $P(RC0,U,5) S RCOK=1 D G:'RCOK DELQ
. N ZTSK
. S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled
. I "12"[ZTSK(1) W *7,!,"This message is currently scheduled for update. Task # is: ",$P(RC0,U,11) S RCOK="" D PAUSE^VALM1
;
S DIR(0)="YA",DIR("A",1)=" ",DIR("A",2)="",$P(DIR("A",2),"*",54)="",DIR("A",3)="* This EDI Lockbox message is about to be PERMANENTLY deleted!! *",DIR("A",4)=DIR("A",2),DIR("A",5)=" "
S DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
W ! D ^DIR W ! K DIR
I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ
;
D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCDIQ")
S RCE=0
D TXTDE(RCTDA,.RCDIQ,1,.RCX,.RCE)
S RCE=RCE+1,RCX(RCE)="RAW MESSAGE DATA:"
D TXTDE(RCTDA,.RCDIQ,2,.RCX,.RCE)
D DELMSG(RCTDA)
I $D(^RCY(344.5,RCTDA)) D G DELQ
. W !,"Message not deleted - problem with delete" D PAUSE^VALM1
;
I $P(RC0,U,2)["XFR",'$P(RC0,U,14) D
. S DIR(0)="YA"
. S DIR("A")="ARE YOU DELETING THIS BECAUSE THE EEOB DOES NOT BELONG TO YOUR SITE?: ",DIR("B")="YES",DIR("?")="IF YOU RESPOND YES TO THIS QUESTION, A REJECT MESSAGE WILL BE SENT BACK TO",DIR("?",1)=" THE SENDING SITE FOR THIS EEOB"
. W ! D ^DIR K DIR
. Q:Y'=1
. D SENDACK^RCDPESR5(RCTDA,0) ; Send reject notice
S RCT(1)="Electronic EDI Lockbox message "_$P(RC0,U)_" has been deleted"
S RCT(2)=" "
S RCT(3)="DELETED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
S RCT(4)=" ",RCE=+$O(RCT(""),-1)
S Z=0 F S Z=$O(RCX(Z)) Q:'Z S RCE=RCE+1,RCT(RCE)=RCX(Z)
S RCE=RCE+1,RCT(RCE)=" "
S XMSUBJ="EDI LBOX MESSAGE DELETED",XMBODY="RCT",XMDUZ="",XMTO("G.RCDPE PAYMENTS")=""
N DUZ S DUZ=.5,DUZ(0)="@"
D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
;
W !,"A bulletin has been sent to report this deletion",!
D PAUSE^VALM1
;
D BLD^RCDPEX1("TRANSMISSION")
DELQ L -^RCY(344.5,RCTDA,0)
S VALMBCK="R"
Q
;
DELMSG(RCTDA) ; Delete message from temporary message holding file 344.5
;
N DIK,DA,Y S DIK="^RCY(344.5,",DA=RCTDA D ^DIK
Q
;
TASK(RCRTN,RCTDA) ; Schedule the task to update data base from message
; RCRTN = routine to task
; RCTDA = internal entry of message in file 344.5
;
N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE
S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EEOB EXCEPTION PROCESSING",ZTSAVE("RC*")="",ZTRTN=RCRTN
D ^%ZTLOAD
I $G(ZTSK),$G(^RCY(344.5,RCTDA,0)) D
. S DIE="^RCY(344.5,",DR=".05////"_ZTSK_";.04////1;.08////0",DA=RCTDA D ^DIE
Q $G(ZTSK)
;
LOCK(RCTDA) ; Attempt to lock message file entry RCTDA in file 344.5
; Return 1 if successful, 0 if not able to lock
;
N OK
S OK=1
L +^RCY(344.5,RCTDA,0):5
I '$T D
. I '$D(DIQUIET) W !,*7,"Another user is editing this entry ... please try again later" D PAUSE^VALM1
. S OK=0
Q OK
;
HDR(RCTDA,RCPG) ;Prints report heading
; RCTDA = ien of file 344.5
; RCPG = page # last printed
N Z
I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
I 'RCPG D
. N RCX,RCZ
. D TXT0(RCTDA,.RCZ,.RCX,0) ; Get 0-node captioned fields
. S Z=0 F S Z=$O(RCX(Z)) Q:'Z S ^TMP($J,"RCHDR_EX",Z)=RCX(Z)
S RCPG=RCPG+1
W !,?15,"EDI LBOX - EEOB EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!
S Z=0 F S Z=$O(^TMP($J,"RCHDR_EX",Z)) Q:'Z W !,$G(^(Z))
W !,$TR($J("",IOM)," ","=")
Q
;
ASK(RCSTOP) ; Ask to stop
; RCSTOP: passed by ref, flag to stop processing
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 parameter definitions ***
; ***
; FUNCTIONs returns RCXM1 and RCCT if passed by reference
; RCTDA = ien, file 344.5
; RCXM1 = the array returned with text, captioned
; RCCT = # of lines already in array (optional)
; RCDIQ = the array returned from GETS^DIQ
; ***
;
TXT0(RCTDA,RCDIQ,RCXM1,RCCT) ; Append 0-node captioned data to array RCXM1
; See above for parameter definitions
;
N RCZ,RCTDAC,LINE,DAT,Z,Z0
S LINE="",RCCT=+$G(RCCT),RCTDAC=RCTDA_","
S Z=0 F S Z=$O(RCDIQ(344.5,RCTDAC,Z)) Q:'Z!(Z'<1) D
. S Z0=$$GET1^DID(344.5,Z,,"LABEL")
. S DAT=Z0_": "_$G(RCDIQ(344.5,RCTDAC,Z,"E"))
. I $L(DAT)>39 S:$L(LINE) RCCT=RCCT+1,RCXM1(RCCT)=LINE S RCCT=RCCT+1,RCXM1(RCCT)=DAT,LINE="" Q
. I $L(LINE) D Q:LINE="" ; Left side exists
.. I $L(LINE)+$L(DAT)>75 S RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=DAT Q
.. S LINE=LINE_" "_DAT,RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=""
. S LINE=$E(DAT_$J("",39),1,39)
I $L(LINE) S RCCT=RCCT+1,RCXM1(RCCT)=LINE
S:RCCT RCCT=RCCT+1,RCXM1(RCCT)=" "
Q
;
TXTDE(RCTDA,RCDIQ,RCNODE,RCXM1,RCCT) ; Append display data to array RCXM1
; See above for parameter definitions
; RCNODE = the WP field # to return
;
N RCCT1,LINE,Z,RCTDAC
S LINE="",RCCT=+$G(RCCT),RCCT1=RCCT
S RCTDAC=RCTDA_","
S Z=0 F S Z=$O(RCDIQ(344.5,RCTDAC,RCNODE,Z)) Q:'Z D
. S RCCT=RCCT+1,RCXM1(RCCT)=$G(RCDIQ(344.5,RCTDAC,RCNODE,Z))
S:RCCT'=RCCT1 RCCT=RCCT+1,RCXM1(RCCT)=" "
Q
;
PAYTYP(RCTDA) ;Find pay source - PRCA*4.5*298
N RCPT,X
S RCPT=""
S X=$G(^RCY(344.5,RCTDA,2,1,0))
I $P(X,U)="835ERA" S RCPT=$P(X,U,17)
Q RCPT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEX 9925 printed Oct 16, 2024@17:46:44 Page 2
RCDPEX ;ALB/TMK,DWA - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.5 ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,208,269,298,332**;Mar 20, 1995;Build 40
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
UPD ; Update (File) ERA msgs manually from EOB exception list for file 344.5
+1 NEW RCDA,RCOK,RCTDA,ZTSK,RCTSK,RCTYP,RCU,RC0
+2 DO FULL^VALM1
+3 DO SEL(.RCDA,1)
+4 SET RCDA=$ORDER(RCDA(""))
+5 IF RCDA=""
GOTO UPDQ
+6 SET RCTDA=+RCDA(RCDA)
+7 IF '$$LOCK(RCTDA)
GOTO UPDQ
+8 SET RC0=$GET(^RCY(344.5,RCTDA,0))
+9 ;
+10 IF RC0=""
Begin DoDot:1
+11 WRITE !,*7,"ERA #",RCDA," is no longer in exception file"
SET RCOK=""
+12 DO PAUSE^VALM1
End DoDot:1
GOTO UPDQ
+13 IF $PIECE(RC0,U,5)
SET RCOK=1
Begin DoDot:1
+14 NEW ZTSK
+15 ;Task not scheduled
SET ZTSK=$PIECE(RC0,U,5)
DO STAT^%ZTLOAD
if ZTSK(0)=0
QUIT
+16 IF "12"[ZTSK(1)
WRITE *7,!,"This record has already been scheduled for update. Task # is: ",$PIECE(RC0,U,5)
SET RCOK=""
DO PAUSE^VALM1
End DoDot:1
if 'RCOK
GOTO UPDQ
+17 ;
+18 SET RCTYP=$PIECE(RC0,U,2)
+19 SET RCU=$SELECT(RCTYP="835ERA":"NEWERA^RCDPESR2("_RCTDA_",1)",RCTYP="835XFR":"FILEEOB^RCDPESR5("_RCTDA_")",1:"")
+20 IF RCU=""
WRITE !,*7,"This message has an invalid 'type' - can't update"
DO PAUSE^VALM1
GOTO UPDQ
+21 SET RCTSK=$$TASK(RCU,RCTDA)
+22 IF RCTSK
WRITE !,"File update has been tasked (#",RCTSK,")"
+23 IF 'RCTSK
WRITE !,*7,"File update could not be tasked. Please try again later!!!"
+24 DO PAUSE^VALM1
+25 ;
+26 DO BLD^RCDPEX1("TRANSMISSION")
UPDQ IF $GET(RCTDA)
LOCK -^RCY(344.5,RCTDA,0)
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
VP ; View/Print ERA Messages - File 344.5
+1 NEW DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,RCDA,RCTDA,RCRAW,POP
+2 DO FULL^VALM1
DO SEL(.RCDA,1)
+3 SET RCDA=$ORDER(RCDA(""))
+4 if 'RCDA
GOTO VPQ
+5 SET RCTDA=$GET(RCDA(RCDA))
+6 SET DIR(0)="YA"
SET DIR("A")="DO YOU WANT TO INCLUDE DATA THE WAY IT WAS RECEIVED (RAW DATA)?: "
SET DIR("B")="N"
DO ^DIR
KILL DIR
+7 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO VPQ
+8 SET RCRAW=+Y
+9 ; Ask device
+10 NEW %ZIS,ZTRTN,ZTSAVE,ZTDESC
+11 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO VPQ
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 SET ZTRTN="VPOUT^RCDPEX"
SET ZTDESC="AR - Print EEOB Exception Message"
+14 SET ZTSAVE("RCTDA")=""
SET ZTSAVE("RCRAW")=""
+15 DO ^%ZTLOAD
+16 WRITE !!,$SELECT($DATA(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
+17 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO VPQ
+18 USE IO
+19 ;
VPOUT ; Entrypoint for queued job
+1 NEW Z,Z0,RCSTOP,RCPG,RCXM,RCXM1,RC,RCZ,RCTDAC,RCV5
+2 KILL ^TMP($JOB,"RCRAW"),^TMP($JOB,"RCOUT")
+3 SET RCTDAC=RCTDA_","
SET RCV5=0
+4 ;
+5 DO GETS^DIQ(344.5,RCTDAC,"*","IEN","RCZ")
+6 DO TXTDE(RCTDA,.RCZ,1,.RCXM,.RC)
+7 ;
+8 IF $ORDER(^RCY(344.5,RCTDA,"EX",0))
Begin DoDot:1
+9 SET RC=RC+1
SET RCXM(RC)="**EXCEPTION MESSAGES**"
+10 DO TXTDE(RCTDA,.RCZ,5,.RCXM,.RC)
End DoDot:1
+11 ;
+12 KILL ^TMP("RCSAVE",$JOB)
+13 MERGE ^TMP("RCSAVE",$JOB)=^RCY(344.5,RCTDA,2)
+14 IF +$PIECE($GET(^TMP("RCSAVE",$JOB,1,0)),U,16)>0
SET RCV5=1
+15 ; Get rid of header node
SET Z=0
FOR
SET Z=$ORDER(^TMP("RCSAVE",$JOB,Z))
if 'Z
QUIT
IF $PIECE($GET(^(Z,0)),U)["835"
KILL ^(0)
QUIT
+16 ; Get formatted 'raw' data
DO DISP^RCDPESR0("^TMP(""RCSAVE"",$J)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75)
+17 KILL ^TMP("RCSAVE",$JOB)
+18 IF $GET(RCRAW)
Begin DoDot:1
+19 SET RC=$ORDER(^TMP($JOB,"RCOUT",""),-1)+1
SET ^TMP($JOB,"RCOUT",RC)=" "
+20 SET RC=RC+1
SET ^TMP($JOB,"RCOUT",RC)="**RAW DATA**"
+21 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.5,RCTDA,2,Z))
if 'Z
QUIT
Begin DoDot:2
+22 FOR Z0=1:80:$LENGTH($GET(^RCY(344.5,RCTDA,2,Z,0)))
SET RC=RC+1
SET ^TMP($JOB,"RCOUT",RC)=$EXTRACT($GET(^RCY(344.5,RCTDA,2,Z,0)),Z0,Z0+79)
End DoDot:2
End DoDot:1
+23 ;
+24 SET (RCPG,RCSTOP,Z)=0
+25 FOR
SET Z=$ORDER(RCXM(Z))
if 'Z
QUIT
SET ^TMP($JOB,"RCOUT",Z-999)=RCXM(Z)
+26 SET Z=""
+27 FOR
SET Z=$ORDER(^TMP($JOB,"RCOUT",Z))
if 'Z
QUIT
Begin DoDot:1
+28 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (RCSTOP,ZTSTOP)=1
KILL ZTREQ
IF +$GET(RCPG)
WRITE !,"***TASK STOPPED BY USER***"
QUIT
+29 IF 'RCPG!(($Y+5)>IOSL)
Begin DoDot:2
+30 if RCPG
DO ASK(.RCSTOP)
IF RCSTOP
QUIT
+31 DO HDR(RCTDA,.RCPG)
End DoDot:2
IF RCSTOP
QUIT
+32 WRITE !,$GET(^TMP($JOB,"RCOUT",Z))
End DoDot:1
if RCSTOP
QUIT
+33 IF 'RCSTOP
IF RCPG
DO ASK(.RCSTOP)
+34 ;
+35 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+36 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+37 ;
VPQ KILL ^TMP($JOB,"RCRAW"),^TMP($JOB,"RCOUT")
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
SEL(RCDA,ONE) ; Select entry(s) from list
+1 ; RCDA = array returned if selections made
+2 ; RCDA(n)=ien of bill selected in file 344.5
+3 ; ONE = if set to 1, only one selection can be made at a time
+4 NEW RC
+5 KILL RCDA
+6 DO EN^VALM2($GET(XQORNOD(0)),$SELECT('$GET(ONE):"",1:"S"))
+7 SET RCDA=0
FOR
SET RCDA=$ORDER(VALMY(RCDA))
if 'RCDA
QUIT
SET RC=$GET(^TMP("RCDPEX-EOBDX",$JOB,RCDA))
SET RCDA(RCDA)=+$PIECE(RC,U,2)
+8 QUIT
+9 ;
+10 ;
DEL ; Delete messages from messages list - file 344.5
+1 NEW RCDA,RCOK,RCTDA,RCTDAC,RCTYP,RCU,RC0,DIR,RCT,RCE,RCDIQ,RCX,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ,XMZ
+2 DO FULL^VALM1
+3 SET RCTDA=0
+4 DO SEL(.RCDA,1)
+5 SET RCDA=$ORDER(RCDA(""))
+6 IF RCDA=""
GOTO DELQ
+7 SET RCTDA=+RCDA(RCDA)
SET RCTDAC=RCTDA_","
+8 SET RCPAYTP=$$PAYTYP(RCTDA)
+9 IF RCPAYTP="ACH"
WRITE !!,"Deletion is not allowed. The ERA has a payment method of ACH."
DO PAUSE^VALM1
QUIT
+10 WRITE !
+11 SET DIR(0)="YA"
SET DIR("A",1)="This action will PERMANENTLY delete an EDI Lockbox message from your system"
SET DIR("A",2)="A bulletin will be sent to report the deletion"
SET DIR("A",3)=" "
+12 SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? "
SET DIR("B")="NO"
+13 DO ^DIR
KILL DIR
+14 if Y'=1
GOTO DELQ
+15 IF '$$LOCK(RCTDA)
GOTO DELQ
+16 SET RC0=$GET(^RCY(344.5,RCTDA,0))
+17 ;
+18 IF $PIECE(RC0,U,5)
SET RCOK=1
Begin DoDot:1
+19 NEW ZTSK
+20 ;Task not scheduled
SET ZTSK=$PIECE(RC0,U,5)
DO STAT^%ZTLOAD
if ZTSK(0)=0
QUIT
+21 IF "12"[ZTSK(1)
WRITE *7,!,"This message is currently scheduled for update. Task # is: ",$PIECE(RC0,U,11)
SET RCOK=""
DO PAUSE^VALM1
End DoDot:1
if 'RCOK
GOTO DELQ
+22 ;
+23 SET DIR(0)="YA"
SET DIR("A",1)=" "
SET DIR("A",2)=""
SET $PIECE(DIR("A",2),"*",54)=""
SET DIR("A",3)="* This EDI Lockbox message is about to be PERMANENTLY deleted!! *"
SET DIR("A",4)=DIR("A",2)
SET DIR("A",5)=" "
+24 SET DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? "
SET DIR("B")="NO"
+25 WRITE !
DO ^DIR
WRITE !
KILL DIR
+26 IF Y'=1
WRITE !!,"Nothing deleted"
DO PAUSE^VALM1
GOTO DELQ
+27 ;
+28 DO GETS^DIQ(344.5,RCTDAC,"*","IEN","RCDIQ")
+29 SET RCE=0
+30 DO TXTDE(RCTDA,.RCDIQ,1,.RCX,.RCE)
+31 SET RCE=RCE+1
SET RCX(RCE)="RAW MESSAGE DATA:"
+32 DO TXTDE(RCTDA,.RCDIQ,2,.RCX,.RCE)
+33 DO DELMSG(RCTDA)
+34 IF $DATA(^RCY(344.5,RCTDA))
Begin DoDot:1
+35 WRITE !,"Message not deleted - problem with delete"
DO PAUSE^VALM1
End DoDot:1
GOTO DELQ
+36 ;
+37 IF $PIECE(RC0,U,2)["XFR"
IF '$PIECE(RC0,U,14)
Begin DoDot:1
+38 SET DIR(0)="YA"
+39 SET DIR("A")="ARE YOU DELETING THIS BECAUSE THE EEOB DOES NOT BELONG TO YOUR SITE?: "
SET DIR("B")="YES"
SET DIR("?")="IF YOU RESPOND YES TO THIS QUESTION, A REJECT MESSAGE WILL BE SENT BACK TO"
SET DIR("?",1)=" THE SENDING SITE FOR THIS EEOB"
+40 WRITE !
DO ^DIR
KILL DIR
+41 if Y'=1
QUIT
+42 ; Send reject notice
DO SENDACK^RCDPESR5(RCTDA,0)
End DoDot:1
+43 SET RCT(1)="Electronic EDI Lockbox message "_$PIECE(RC0,U)_" has been deleted"
+44 SET RCT(2)=" "
+45 SET RCT(3)="DELETED BY: "_$PIECE($GET(^VA(200,+$GET(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
+46 SET RCT(4)=" "
SET RCE=+$ORDER(RCT(""),-1)
+47 SET Z=0
FOR
SET Z=$ORDER(RCX(Z))
if 'Z
QUIT
SET RCE=RCE+1
SET RCT(RCE)=RCX(Z)
+48 SET RCE=RCE+1
SET RCT(RCE)=" "
+49 SET XMSUBJ="EDI LBOX MESSAGE DELETED"
SET XMBODY="RCT"
SET XMDUZ=""
SET XMTO("G.RCDPE PAYMENTS")=""
+50 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+51 DO SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
+52 ;
+53 WRITE !,"A bulletin has been sent to report this deletion",!
+54 DO PAUSE^VALM1
+55 ;
+56 DO BLD^RCDPEX1("TRANSMISSION")
DELQ LOCK -^RCY(344.5,RCTDA,0)
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
DELMSG(RCTDA) ; Delete message from temporary message holding file 344.5
+1 ;
+2 NEW DIK,DA,Y
SET DIK="^RCY(344.5,"
SET DA=RCTDA
DO ^DIK
+3 QUIT
+4 ;
TASK(RCRTN,RCTDA) ; Schedule the task to update data base from message
+1 ; RCRTN = routine to task
+2 ; RCTDA = internal entry of message in file 344.5
+3 ;
+4 NEW ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE
+5 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="UPDATE DATA BASE FROM EEOB EXCEPTION PROCESSING"
SET ZTSAVE("RC*")=""
SET ZTRTN=RCRTN
+6 DO ^%ZTLOAD
+7 IF $GET(ZTSK)
IF $GET(^RCY(344.5,RCTDA,0))
Begin DoDot:1
+8 SET DIE="^RCY(344.5,"
SET DR=".05////"_ZTSK_";.04////1;.08////0"
SET DA=RCTDA
DO ^DIE
End DoDot:1
+9 QUIT $GET(ZTSK)
+10 ;
LOCK(RCTDA) ; Attempt to lock message file entry RCTDA in file 344.5
+1 ; Return 1 if successful, 0 if not able to lock
+2 ;
+3 NEW OK
+4 SET OK=1
+5 LOCK +^RCY(344.5,RCTDA,0):5
+6 IF '$TEST
Begin DoDot:1
+7 IF '$DATA(DIQUIET)
WRITE !,*7,"Another user is editing this entry ... please try again later"
DO PAUSE^VALM1
+8 SET OK=0
End DoDot:1
+9 QUIT OK
+10 ;
HDR(RCTDA,RCPG) ;Prints report heading
+1 ; RCTDA = ien of file 344.5
+2 ; RCPG = page # last printed
+3 NEW Z
+4 IF RCPG!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF,*13
+5 IF 'RCPG
Begin DoDot:1
+6 NEW RCX,RCZ
+7 ; Get 0-node captioned fields
DO TXT0(RCTDA,.RCZ,.RCX,0)
+8 SET Z=0
FOR
SET Z=$ORDER(RCX(Z))
if 'Z
QUIT
SET ^TMP($JOB,"RCHDR_EX",Z)=RCX(Z)
End DoDot:1
+9 SET RCPG=RCPG+1
+10 WRITE !,?15,"EDI LBOX - EEOB EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!
+11 SET Z=0
FOR
SET Z=$ORDER(^TMP($JOB,"RCHDR_EX",Z))
if 'Z
QUIT
WRITE !,$GET(^(Z))
+12 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+13 QUIT
+14 ;
ASK(RCSTOP) ; Ask to stop
+1 ; RCSTOP: passed by ref, flag to stop processing
+2 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 SET DIR(0)="E"
WRITE !
DO ^DIR
+5 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET RCSTOP=1
QUIT
+6 QUIT
+7 ; ***
+8 ; *** Entrypoints TXT* assume these parameter definitions ***
+9 ; ***
+10 ; FUNCTIONs returns RCXM1 and RCCT if passed by reference
+11 ; RCTDA = ien, file 344.5
+12 ; RCXM1 = the array returned with text, captioned
+13 ; RCCT = # of lines already in array (optional)
+14 ; RCDIQ = the array returned from GETS^DIQ
+15 ; ***
+16 ;
TXT0(RCTDA,RCDIQ,RCXM1,RCCT) ; Append 0-node captioned data to array RCXM1
+1 ; See above for parameter definitions
+2 ;
+3 NEW RCZ,RCTDAC,LINE,DAT,Z,Z0
+4 SET LINE=""
SET RCCT=+$GET(RCCT)
SET RCTDAC=RCTDA_","
+5 SET Z=0
FOR
SET Z=$ORDER(RCDIQ(344.5,RCTDAC,Z))
if 'Z!(Z'<1)
QUIT
Begin DoDot:1
+6 SET Z0=$$GET1^DID(344.5,Z,,"LABEL")
+7 SET DAT=Z0_": "_$GET(RCDIQ(344.5,RCTDAC,Z,"E"))
+8 IF $LENGTH(DAT)>39
if $LENGTH(LINE)
SET RCCT=RCCT+1
SET RCXM1(RCCT)=LINE
SET RCCT=RCCT+1
SET RCXM1(RCCT)=DAT
SET LINE=""
QUIT
+9 ; Left side exists
IF $LENGTH(LINE)
Begin DoDot:2
+10 IF $LENGTH(LINE)+$LENGTH(DAT)>75
SET RCCT=RCCT+1
SET RCXM1(RCCT)=LINE
SET LINE=DAT
QUIT
+11 SET LINE=LINE_" "_DAT
SET RCCT=RCCT+1
SET RCXM1(RCCT)=LINE
SET LINE=""
End DoDot:2
if LINE=""
QUIT
+12 SET LINE=$EXTRACT(DAT_$JUSTIFY("",39),1,39)
End DoDot:1
+13 IF $LENGTH(LINE)
SET RCCT=RCCT+1
SET RCXM1(RCCT)=LINE
+14 if RCCT
SET RCCT=RCCT+1
SET RCXM1(RCCT)=" "
+15 QUIT
+16 ;
TXTDE(RCTDA,RCDIQ,RCNODE,RCXM1,RCCT) ; Append display data to array RCXM1
+1 ; See above for parameter definitions
+2 ; RCNODE = the WP field # to return
+3 ;
+4 NEW RCCT1,LINE,Z,RCTDAC
+5 SET LINE=""
SET RCCT=+$GET(RCCT)
SET RCCT1=RCCT
+6 SET RCTDAC=RCTDA_","
+7 SET Z=0
FOR
SET Z=$ORDER(RCDIQ(344.5,RCTDAC,RCNODE,Z))
if 'Z
QUIT
Begin DoDot:1
+8 SET RCCT=RCCT+1
SET RCXM1(RCCT)=$GET(RCDIQ(344.5,RCTDAC,RCNODE,Z))
End DoDot:1
+9 if RCCT'=RCCT1
SET RCCT=RCCT+1
SET RCXM1(RCCT)=" "
+10 QUIT
+11 ;
PAYTYP(RCTDA) ;Find pay source - PRCA*4.5*298
+1 NEW RCPT,X
+2 SET RCPT=""
+3 SET X=$GET(^RCY(344.5,RCTDA,2,1,0))
+4 IF $PIECE(X,U)="835ERA"
SET RCPT=$PIECE(X,U,17)
+5 QUIT RCPT
