- 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 Feb 18, 2025@23:12:17 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