RCDPEX ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.5 ;10-OCT-02
 ;;4.5;Accounts Receivable;**173,208**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, 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
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
 K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
 S RCTDAC=RCTDA_","
 ;
 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)
 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
 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
 S RCTDA=+RCDA(RCDA),RCTDAC=RCTDA_","
 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")=""
 D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
 ;
 W !,"A bulletin has been sent to report this deletion",!
 D PAUSE^VALM1
 ;
 D BLD^RCDPEX1
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
 ;