Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPEX

RCDPEX.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. UPD ; Update (File) ERA msgs manually from EOB exception list for file 344.5
  1. N RCDA,RCOK,RCTDA,ZTSK,RCTSK,RCTYP,RCU,RC0
  1. D FULL^VALM1
  1. D SEL(.RCDA,1)
  1. S RCDA=$O(RCDA(""))
  1. I RCDA="" G UPDQ
  1. S RCTDA=+RCDA(RCDA)
  1. I '$$LOCK(RCTDA) G UPDQ
  1. S RC0=$G(^RCY(344.5,RCTDA,0))
  1. ;
  1. I RC0="" D G UPDQ
  1. . W !,*7,"ERA #",RCDA," is no longer in exception file" S RCOK=""
  1. . D PAUSE^VALM1
  1. I $P(RC0,U,5) S RCOK=1 D G:'RCOK UPDQ
  1. . N ZTSK
  1. . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled
  1. . 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
  1. ;
  1. S RCTYP=$P(RC0,U,2)
  1. S RCU=$S(RCTYP="835ERA":"NEWERA^RCDPESR2("_RCTDA_",1)",RCTYP="835XFR":"FILEEOB^RCDPESR5("_RCTDA_")",1:"")
  1. I RCU="" W !,*7,"This message has an invalid 'type' - can't update" D PAUSE^VALM1 G UPDQ
  1. S RCTSK=$$TASK(RCU,RCTDA)
  1. I RCTSK W !,"File update has been tasked (#",RCTSK,")"
  1. I 'RCTSK W !,*7,"File update could not be tasked. Please try again later!!!"
  1. D PAUSE^VALM1
  1. ;
  1. D BLD^RCDPEX1("TRANSMISSION")
  1. UPDQ I $G(RCTDA) L -^RCY(344.5,RCTDA,0)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. VP ; View/Print ERA Messages - File 344.5
  1. N DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,RCDA,RCTDA,RCRAW,POP
  1. D FULL^VALM1,SEL(.RCDA,1)
  1. S RCDA=$O(RCDA(""))
  1. G:'RCDA VPQ
  1. S RCTDA=$G(RCDA(RCDA))
  1. 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
  1. I $D(DUOUT)!$D(DTOUT) G VPQ
  1. S RCRAW=+Y
  1. ; Ask device
  1. N %ZIS,ZTRTN,ZTSAVE,ZTDESC
  1. S %ZIS="QM" D ^%ZIS G:POP VPQ
  1. I $D(IO("Q")) D G VPQ
  1. . S ZTRTN="VPOUT^RCDPEX",ZTDESC="AR - Print EEOB Exception Message"
  1. . S ZTSAVE("RCTDA")="",ZTSAVE("RCRAW")=""
  1. . D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1. . K ZTSK,IO("Q") D HOME^%ZIS
  1. U IO
  1. ;
  1. VPOUT ; Entrypoint for queued job
  1. N Z,Z0,RCSTOP,RCPG,RCXM,RCXM1,RC,RCZ,RCTDAC,RCV5
  1. K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
  1. S RCTDAC=RCTDA_",",RCV5=0
  1. ;
  1. D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCZ")
  1. D TXTDE(RCTDA,.RCZ,1,.RCXM,.RC)
  1. ;
  1. I $O(^RCY(344.5,RCTDA,"EX",0)) D
  1. . S RC=RC+1,RCXM(RC)="**EXCEPTION MESSAGES**"
  1. . D TXTDE(RCTDA,.RCZ,5,.RCXM,.RC)
  1. ;
  1. K ^TMP("RCSAVE",$J)
  1. M ^TMP("RCSAVE",$J)=^RCY(344.5,RCTDA,2)
  1. I +$P($G(^TMP("RCSAVE",$J,1,0)),U,16)>0 S RCV5=1
  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
  1. D DISP^RCDPESR0("^TMP(""RCSAVE"",$J)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75) ; Get formatted 'raw' data
  1. K ^TMP("RCSAVE",$J)
  1. I $G(RCRAW) D
  1. . S RC=$O(^TMP($J,"RCOUT",""),-1)+1,^TMP($J,"RCOUT",RC)=" "
  1. . S RC=RC+1,^TMP($J,"RCOUT",RC)="**RAW DATA**"
  1. . S Z=0 F S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z D
  1. .. 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)
  1. ;
  1. S (RCPG,RCSTOP,Z)=0
  1. F S Z=$O(RCXM(Z)) Q:'Z S ^TMP($J,"RCOUT",Z-999)=RCXM(Z)
  1. S Z=""
  1. F S Z=$O(^TMP($J,"RCOUT",Z)) Q:'Z D Q:RCSTOP
  1. . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q
  1. . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
  1. .. D:RCPG ASK(.RCSTOP) I RCSTOP Q
  1. .. D HDR(RCTDA,.RCPG)
  1. . W !,$G(^TMP($J,"RCOUT",Z))
  1. I 'RCSTOP,RCPG D ASK(.RCSTOP)
  1. ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I '$D(ZTQUEUED) D ^%ZISC
  1. ;
  1. VPQ K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT")
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. SEL(RCDA,ONE) ; Select entry(s) from list
  1. ; RCDA = array returned if selections made
  1. ; RCDA(n)=ien of bill selected in file 344.5
  1. ; ONE = if set to 1, only one selection can be made at a time
  1. N RC
  1. K RCDA
  1. D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
  1. 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)
  1. Q
  1. ;
  1. ;
  1. DEL ; Delete messages from messages list - file 344.5
  1. N RCDA,RCOK,RCTDA,RCTDAC,RCTYP,RCU,RC0,DIR,RCT,RCE,RCDIQ,RCX,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ,XMZ
  1. D FULL^VALM1
  1. S RCTDA=0
  1. D SEL(.RCDA,1)
  1. S RCDA=$O(RCDA(""))
  1. I RCDA="" G DELQ
  1. S RCTDA=+RCDA(RCDA),RCTDAC=RCTDA_","
  1. S RCPAYTP=$$PAYTYP(RCTDA)
  1. I RCPAYTP="ACH" W !!,"Deletion is not allowed. The ERA has a payment method of ACH." D PAUSE^VALM1 Q
  1. W !
  1. 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)=" "
  1. S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
  1. D ^DIR K DIR
  1. G:Y'=1 DELQ
  1. I '$$LOCK(RCTDA) G DELQ
  1. S RC0=$G(^RCY(344.5,RCTDA,0))
  1. ;
  1. I $P(RC0,U,5) S RCOK=1 D G:'RCOK DELQ
  1. . N ZTSK
  1. . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled
  1. . I "12"[ZTSK(1) W *7,!,"This message is currently scheduled for update. Task # is: ",$P(RC0,U,11) S RCOK="" D PAUSE^VALM1
  1. ;
  1. 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)=" "
  1. S DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
  1. W ! D ^DIR W ! K DIR
  1. I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ
  1. ;
  1. D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCDIQ")
  1. S RCE=0
  1. D TXTDE(RCTDA,.RCDIQ,1,.RCX,.RCE)
  1. S RCE=RCE+1,RCX(RCE)="RAW MESSAGE DATA:"
  1. D TXTDE(RCTDA,.RCDIQ,2,.RCX,.RCE)
  1. D DELMSG(RCTDA)
  1. I $D(^RCY(344.5,RCTDA)) D G DELQ
  1. . W !,"Message not deleted - problem with delete" D PAUSE^VALM1
  1. ;
  1. I $P(RC0,U,2)["XFR",'$P(RC0,U,14) D
  1. . S DIR(0)="YA"
  1. . 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"
  1. . W ! D ^DIR K DIR
  1. . Q:Y'=1
  1. . D SENDACK^RCDPESR5(RCTDA,0) ; Send reject notice
  1. S RCT(1)="Electronic EDI Lockbox message "_$P(RC0,U)_" has been deleted"
  1. S RCT(2)=" "
  1. S RCT(3)="DELETED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
  1. S RCT(4)=" ",RCE=+$O(RCT(""),-1)
  1. S Z=0 F S Z=$O(RCX(Z)) Q:'Z S RCE=RCE+1,RCT(RCE)=RCX(Z)
  1. S RCE=RCE+1,RCT(RCE)=" "
  1. S XMSUBJ="EDI LBOX MESSAGE DELETED",XMBODY="RCT",XMDUZ="",XMTO("G.RCDPE PAYMENTS")=""
  1. N DUZ S DUZ=.5,DUZ(0)="@"
  1. D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1. ;
  1. W !,"A bulletin has been sent to report this deletion",!
  1. D PAUSE^VALM1
  1. ;
  1. D BLD^RCDPEX1("TRANSMISSION")
  1. DELQ L -^RCY(344.5,RCTDA,0)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. DELMSG(RCTDA) ; Delete message from temporary message holding file 344.5
  1. ;
  1. N DIK,DA,Y S DIK="^RCY(344.5,",DA=RCTDA D ^DIK
  1. Q
  1. ;
  1. TASK(RCRTN,RCTDA) ; Schedule the task to update data base from message
  1. ; RCRTN = routine to task
  1. ; RCTDA = internal entry of message in file 344.5
  1. ;
  1. N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE
  1. S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EEOB EXCEPTION PROCESSING",ZTSAVE("RC*")="",ZTRTN=RCRTN
  1. D ^%ZTLOAD
  1. I $G(ZTSK),$G(^RCY(344.5,RCTDA,0)) D
  1. . S DIE="^RCY(344.5,",DR=".05////"_ZTSK_";.04////1;.08////0",DA=RCTDA D ^DIE
  1. Q $G(ZTSK)
  1. ;
  1. LOCK(RCTDA) ; Attempt to lock message file entry RCTDA in file 344.5
  1. ; Return 1 if successful, 0 if not able to lock
  1. ;
  1. N OK
  1. S OK=1
  1. L +^RCY(344.5,RCTDA,0):5
  1. I '$T D
  1. . I '$D(DIQUIET) W !,*7,"Another user is editing this entry ... please try again later" D PAUSE^VALM1
  1. . S OK=0
  1. Q OK
  1. ;
  1. HDR(RCTDA,RCPG) ;Prints report heading
  1. ; RCTDA = ien of file 344.5
  1. ; RCPG = page # last printed
  1. N Z
  1. I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
  1. I 'RCPG D
  1. . N RCX,RCZ
  1. . D TXT0(RCTDA,.RCZ,.RCX,0) ; Get 0-node captioned fields
  1. . S Z=0 F S Z=$O(RCX(Z)) Q:'Z S ^TMP($J,"RCHDR_EX",Z)=RCX(Z)
  1. S RCPG=RCPG+1
  1. W !,?15,"EDI LBOX - EEOB EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!
  1. S Z=0 F S Z=$O(^TMP($J,"RCHDR_EX",Z)) Q:'Z W !,$G(^(Z))
  1. W !,$TR($J("",IOM)," ","=")
  1. Q
  1. ;
  1. ASK(RCSTOP) ; Ask to stop
  1. ; RCSTOP: passed by ref, flag to stop processing
  1. I $E(IOST,1,2)'["C-" Q
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="E" W ! D ^DIR
  1. I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
  1. Q
  1. ; ***
  1. ; *** Entrypoints TXT* assume these parameter definitions ***
  1. ; ***
  1. ; FUNCTIONs returns RCXM1 and RCCT if passed by reference
  1. ; RCTDA = ien, file 344.5
  1. ; RCXM1 = the array returned with text, captioned
  1. ; RCCT = # of lines already in array (optional)
  1. ; RCDIQ = the array returned from GETS^DIQ
  1. ; ***
  1. ;
  1. TXT0(RCTDA,RCDIQ,RCXM1,RCCT) ; Append 0-node captioned data to array RCXM1
  1. ; See above for parameter definitions
  1. ;
  1. N RCZ,RCTDAC,LINE,DAT,Z,Z0
  1. S LINE="",RCCT=+$G(RCCT),RCTDAC=RCTDA_","
  1. S Z=0 F S Z=$O(RCDIQ(344.5,RCTDAC,Z)) Q:'Z!(Z'<1) D
  1. . S Z0=$$GET1^DID(344.5,Z,,"LABEL")
  1. . S DAT=Z0_": "_$G(RCDIQ(344.5,RCTDAC,Z,"E"))
  1. . I $L(DAT)>39 S:$L(LINE) RCCT=RCCT+1,RCXM1(RCCT)=LINE S RCCT=RCCT+1,RCXM1(RCCT)=DAT,LINE="" Q
  1. . I $L(LINE) D Q:LINE="" ; Left side exists
  1. .. I $L(LINE)+$L(DAT)>75 S RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=DAT Q
  1. .. S LINE=LINE_" "_DAT,RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=""
  1. . S LINE=$E(DAT_$J("",39),1,39)
  1. I $L(LINE) S RCCT=RCCT+1,RCXM1(RCCT)=LINE
  1. S:RCCT RCCT=RCCT+1,RCXM1(RCCT)=" "
  1. Q
  1. ;
  1. TXTDE(RCTDA,RCDIQ,RCNODE,RCXM1,RCCT) ; Append display data to array RCXM1
  1. ; See above for parameter definitions
  1. ; RCNODE = the WP field # to return
  1. ;
  1. N RCCT1,LINE,Z,RCTDAC
  1. S LINE="",RCCT=+$G(RCCT),RCCT1=RCCT
  1. S RCTDAC=RCTDA_","
  1. S Z=0 F S Z=$O(RCDIQ(344.5,RCTDAC,RCNODE,Z)) Q:'Z D
  1. . S RCCT=RCCT+1,RCXM1(RCCT)=$G(RCDIQ(344.5,RCTDAC,RCNODE,Z))
  1. S:RCCT'=RCCT1 RCCT=RCCT+1,RCXM1(RCCT)=" "
  1. Q
  1. ;
  1. PAYTYP(RCTDA) ;Find pay source - PRCA*4.5*298
  1. N RCPT,X
  1. S RCPT=""
  1. S X=$G(^RCY(344.5,RCTDA,2,1,0))
  1. I $P(X,U)="835ERA" S RCPT=$P(X,U,17)
  1. Q RCPT