- RCDPEX5 ;ALB/TMK,DWA - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.5 ;8 Aug 2018 21:44:13
- ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40
- ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- UPD ; Update (File) ERA msgs manually from DUPLICATE exception list for file 344.5
- N RC0,RCDA,RCLKBXDA,RCOK,RCTSK,RCTYP,RCU,ZTSK
- D FULL^VALM1
- D SEL(.RCDA,1)
- S RCDA=$O(RCDA(""))
- I RCDA="" G UPDQ
- S RCLKBXDA=+RCDA(RCDA)
- S RC0=$G(^RCY(344.5,RCLKBXDA,0))
- I RC0="" D G UPDQ
- . W !,$C(7)_"ERA #"_RCDA_" is no longer in exception file" S RCOK=0
- . D PAUSE^VALM1
- ;
- I '$$LOCK(RCLKBXDA) D G UPDQ
- . W !,$C(7)_"Could not Lock ERA #"_RCDA_" to file it." S RCOK=0
- . D PAUSE^VALM1
- ;
- S RC0=$G(^RCY(344.5,RCLKBXDA,0))
- I RC0="" D G UPDQ
- . W !,$C(7)_"ERA #"_RCDA_" is no longer in exception file" S RCOK=0
- . 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 !,$C(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("_RCLKBXDA_",1)",RCTYP="835XFR":"FILEEOB^RCDPESR5("_RCLKBXDA_")",1:"")
- I RCU="" W !,$C(7)_"This message has an invalid 'type' - can't update" D PAUSE^VALM1 G UPDQ
- S RCTSK=$$TASK(RCU,RCLKBXDA)
- I RCTSK W !,"File update has been tasked (#"_RCTSK_")"
- I 'RCTSK W !,$C(7)_"File update could not be tasked. Please try again later!"
- D PAUSE^VALM1
- ;
- D BLD^RCDPEX1("DUPLICATE ERA")
- UPDQ ; fall through or GOTO from above
- I $G(RCLKBXDA) L -^RCY(344.5,RCLKBXDA)
- 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^RCDPEX(RCTDA,.RCZ,1,.RCXM,.RC)
- ;
- I $O(^RCY(344.5,RCTDA,"EX",0)) D
- . S RC=RC+1,RCXM(RC)="**EXCEPTION MESSAGES**"
- . D TXTDE^RCDPEX(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^RCDPEX(.RCSTOP) I RCSTOP Q
- .. D HDR(RCTDA,.RCPG)
- . W !,$G(^TMP($J,"RCOUT",Z))
- I 'RCSTOP,RCPG D ASK^RCDPEX(.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 ; RCDPEX DELETE DUP MESSAGE option
- ; Delete messages from messages list - file 344.5
- N DIR,RC0,RCDA,RCDIQ,RCE,RCLKBXDA,RCOK,RCPAYTP,RCT,RCTYP,RCU,RCX,Z
- D FULL^VALM1
- S RCLKBXDA=0
- D SEL(.RCDA,1)
- S RCDA=$O(RCDA(""))
- I RCDA="" G DELQ
- S RCLKBXDA=+RCDA(RCDA),RCLKBXDA("iens")=RCLKBXDA_","
- S RCPAYTP=$$PAYTYP^RCDPEX(RCLKBXDA)
- 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"
- W ! D ^DIR K DIR
- G:Y'=1 DELQ
- I '$$LOCK(RCLKBXDA) D G DELQ
- . K DIR
- . S DIR(0)="EA",DIR("A",1)=" ",DIR("A",2)="Unable to lock the EDI LOCKBOX MESSAGE for deletion."
- . S DIR("A")="Press ENTER: " D ^DIR
- S RC0=$G(^RCY(344.5,RCLKBXDA,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 !,$C(7)_"This Lockbox message is 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),"*",66)="",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 SNDMLMN(RCLKBXDA),LKBXDEL(RCLKBXDA)
- I $D(^RCY(344.5,RCLKBXDA)) D G DELQ
- . W !,"EDI Lockbox message not deleted - problem with deletion." D PAUSE^VALM1
- ;
- W !,"A MailMan message has been sent to report this deletion.",!
- D PAUSE^VALM1,BLD^RCDPEX1("DUPLICATE ERA")
- ;
- DELQ ; fall through or GOTO here
- L -^RCY(344.5,RCLKBXDA,0)
- S VALMBCK="R"
- Q
- ;
- SNDMLMN(RCLKBXDA) ; send MailMan message about RCLKBXDA entry in 344.5
- N J,LN,RCDPDATA,X,XMINSTR,XMTO,XMZ,Y
- K ^TMP($J,"RCMMSG") ; mail text storage
- S DR=".01:.04;.07:.15"
- D DIQ3445^RCDPEX1(RCLKBXDA,DR) ; returns RCDPDATA array
- ; create MailMan text
- S LN=1,^TMP($J,"RCMMSG",LN,0)="An EDI LOCKBOX MESSAGE was deleted "_$$FMTE^XLFDT($$NOW^XLFDT)
- S LN=LN+1,^TMP($J,"RCMMSG",LN,0)="The user: "_$$GET1^DIQ(200,DUZ_",",.01)_" (User #"_DUZ_")"
- S LN=LN+1,^TMP($J,"RCMMSG",LN,0)=" ",LN=LN+1,^TMP($J,"RCMMSG",LN,0)="Deleted Lockbox Message Information: "
- ; add data and field labels to message
- F J=.01:.01:.04,.07:.01:.15 D
- . S X=$G(RCDPDATA(344.5,RCLKBXDA,J,"E")) Q:X="" ; skip null fields
- . S LN=LN+1,^TMP($J,"RCMMSG",LN,0)=" > "_$$GET1^DID(344.5,J,"","LABEL")_": "_X
- ; send as a priority message
- S XMTO(DUZ)="",XMTO("G.RCDPE PAYMENTS MGMT")="",XMINSTR("FLAGS")="P"
- D SENDMSG^XMXAPI(DUZ,"EDI LOCKBOX MESSAGE DELETION",$NA(^TMP($J,"RCMMSG")),.XMTO,.XMINSTR,.XMZ)
- I '$G(ZTSK),$E(IOST,1,2)="C-",$G(XMZ) W !,"MailMan message #"_XMZ_" sent."
- K ^TMP($J,"RCMMSG")
- Q
- ;
- LKBXDEL(RCLKBXDA) ;Delete entry from AR EDI LOCKBOX MESSAGES file
- N DA,DIC,DIK,X,Y S DIK="^RCY(344.5,",DA=RCLKBXDA D ^DIK
- Q
- ;
- TASK(RCRTN,RCLKBXDA) ;function, Schedule the task to update data base from message
- ; RCRTN - routine to task
- ; RCLKBXDA - IEN in file 344.5
- ; returns: TaskMan task #
- 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,RCLKBXDA,0)) D
- . S DIE="^RCY(344.5,",DR=".05///"_ZTSK_";.04///1;.08///0",DA=RCLKBXDA D ^DIE
- Q $G(ZTSK)
- ;
- LOCK(RCLKBXDA) ; Boolean function, lock entry RCLKBXDA in file 344.5
- ; Return 1 if successful, else zero
- Q:'($G(RCLKBXDA)>0) "^no 344.5 IEN to lock" ; error message is also false
- N LCK L +^RCY(344.5,RCLKBXDA,0):DILOCKTM S LCK=$T
- Q LCK
- ;
- 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^RCDPEX(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 - DUPLICATE ERA - 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEX5 8617 printed Feb 18, 2025@23:12:24 Page 2
- RCDPEX5 ;ALB/TMK,DWA - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.5 ;8 Aug 2018 21:44:13
- +1 ;;4.5;Accounts Receivable;**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 DUPLICATE exception list for file 344.5
- +1 NEW RC0,RCDA,RCLKBXDA,RCOK,RCTSK,RCTYP,RCU,ZTSK
- +2 DO FULL^VALM1
- +3 DO SEL(.RCDA,1)
- +4 SET RCDA=$ORDER(RCDA(""))
- +5 IF RCDA=""
- GOTO UPDQ
- +6 SET RCLKBXDA=+RCDA(RCDA)
- +7 SET RC0=$GET(^RCY(344.5,RCLKBXDA,0))
- +8 IF RC0=""
- Begin DoDot:1
- +9 WRITE !,$CHAR(7)_"ERA #"_RCDA_" is no longer in exception file"
- SET RCOK=0
- +10 DO PAUSE^VALM1
- End DoDot:1
- GOTO UPDQ
- +11 ;
- +12 IF '$$LOCK(RCLKBXDA)
- Begin DoDot:1
- +13 WRITE !,$CHAR(7)_"Could not Lock ERA #"_RCDA_" to file it."
- SET RCOK=0
- +14 DO PAUSE^VALM1
- End DoDot:1
- GOTO UPDQ
- +15 ;
- +16 SET RC0=$GET(^RCY(344.5,RCLKBXDA,0))
- +17 IF RC0=""
- Begin DoDot:1
- +18 WRITE !,$CHAR(7)_"ERA #"_RCDA_" is no longer in exception file"
- SET RCOK=0
- +19 DO PAUSE^VALM1
- End DoDot:1
- GOTO UPDQ
- +20 IF $PIECE(RC0,U,5)
- SET RCOK=1
- Begin DoDot:1
- +21 NEW ZTSK
- +22 ;Task not scheduled
- SET ZTSK=$PIECE(RC0,U,5)
- DO STAT^%ZTLOAD
- if ZTSK(0)=0
- QUIT
- +23 IF "12"[ZTSK(1)
- WRITE !,$CHAR(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
- +24 ;
- +25 SET RCTYP=$PIECE(RC0,U,2)
- +26 SET RCU=$SELECT(RCTYP="835ERA":"NEWERA^RCDPESR2("_RCLKBXDA_",1)",RCTYP="835XFR":"FILEEOB^RCDPESR5("_RCLKBXDA_")",1:"")
- +27 IF RCU=""
- WRITE !,$CHAR(7)_"This message has an invalid 'type' - can't update"
- DO PAUSE^VALM1
- GOTO UPDQ
- +28 SET RCTSK=$$TASK(RCU,RCLKBXDA)
- +29 IF RCTSK
- WRITE !,"File update has been tasked (#"_RCTSK_")"
- +30 IF 'RCTSK
- WRITE !,$CHAR(7)_"File update could not be tasked. Please try again later!"
- +31 DO PAUSE^VALM1
- +32 ;
- +33 DO BLD^RCDPEX1("DUPLICATE ERA")
- UPDQ ; fall through or GOTO from above
- +1 IF $GET(RCLKBXDA)
- LOCK -^RCY(344.5,RCLKBXDA)
- +2 SET VALMBCK="R"
- +3 QUIT
- +4 ;
- 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^RCDPEX(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^RCDPEX(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^RCDPEX(.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^RCDPEX(.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 ;
- DEL ; RCDPEX DELETE DUP MESSAGE option
- +1 ; Delete messages from messages list - file 344.5
- +2 NEW DIR,RC0,RCDA,RCDIQ,RCE,RCLKBXDA,RCOK,RCPAYTP,RCT,RCTYP,RCU,RCX,Z
- +3 DO FULL^VALM1
- +4 SET RCLKBXDA=0
- +5 DO SEL(.RCDA,1)
- +6 SET RCDA=$ORDER(RCDA(""))
- +7 IF RCDA=""
- GOTO DELQ
- +8 SET RCLKBXDA=+RCDA(RCDA)
- SET RCLKBXDA("iens")=RCLKBXDA_","
- +9 SET RCPAYTP=$$PAYTYP^RCDPEX(RCLKBXDA)
- +10 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)=" "
- +11 SET DIR("A")="Are you sure you want to continue? "
- SET DIR("B")="NO"
- +12 WRITE !
- DO ^DIR
- KILL DIR
- +13 if Y'=1
- GOTO DELQ
- +14 IF '$$LOCK(RCLKBXDA)
- Begin DoDot:1
- +15 KILL DIR
- +16 SET DIR(0)="EA"
- SET DIR("A",1)=" "
- SET DIR("A",2)="Unable to lock the EDI LOCKBOX MESSAGE for deletion."
- +17 SET DIR("A")="Press ENTER: "
- DO ^DIR
- End DoDot:1
- GOTO DELQ
- +18 SET RC0=$GET(^RCY(344.5,RCLKBXDA,0))
- +19 ;
- +20 IF $PIECE(RC0,U,5)
- SET RCOK=1
- Begin DoDot:1
- +21 NEW ZTSK
- +22 ;Task not scheduled
- SET ZTSK=$PIECE(RC0,U,5)
- DO STAT^%ZTLOAD
- if ZTSK(0)=0
- QUIT
- +23 IF "12"[ZTSK(1)
- WRITE !,$CHAR(7)_"This Lockbox message is scheduled for update. Task # is: "_$PIECE(RC0,U,11)
- SET RCOK=""
- DO PAUSE^VALM1
- End DoDot:1
- if 'RCOK
- GOTO DELQ
- +24 ;
- +25 SET DIR(0)="YA"
- SET DIR("A",1)=" "
- SET DIR("A",2)=""
- SET $PIECE(DIR("A",2),"*",66)=""
- 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)=" "
- +26 SET DIR("A")="Are you STILL sure you want to continue? "
- SET DIR("B")="NO"
- +27 WRITE !
- DO ^DIR
- WRITE !
- KILL DIR
- +28 IF Y'=1
- WRITE !!,"Nothing deleted"
- DO PAUSE^VALM1
- GOTO DELQ
- +29 ;
- +30 DO SNDMLMN(RCLKBXDA)
- DO LKBXDEL(RCLKBXDA)
- +31 IF $DATA(^RCY(344.5,RCLKBXDA))
- Begin DoDot:1
- +32 WRITE !,"EDI Lockbox message not deleted - problem with deletion."
- DO PAUSE^VALM1
- End DoDot:1
- GOTO DELQ
- +33 ;
- +34 WRITE !,"A MailMan message has been sent to report this deletion.",!
- +35 DO PAUSE^VALM1
- DO BLD^RCDPEX1("DUPLICATE ERA")
- +36 ;
- DELQ ; fall through or GOTO here
- +1 LOCK -^RCY(344.5,RCLKBXDA,0)
- +2 SET VALMBCK="R"
- +3 QUIT
- +4 ;
- SNDMLMN(RCLKBXDA) ; send MailMan message about RCLKBXDA entry in 344.5
- +1 NEW J,LN,RCDPDATA,X,XMINSTR,XMTO,XMZ,Y
- +2 ; mail text storage
- KILL ^TMP($JOB,"RCMMSG")
- +3 SET DR=".01:.04;.07:.15"
- +4 ; returns RCDPDATA array
- DO DIQ3445^RCDPEX1(RCLKBXDA,DR)
- +5 ; create MailMan text
- +6 SET LN=1
- SET ^TMP($JOB,"RCMMSG",LN,0)="An EDI LOCKBOX MESSAGE was deleted "_$$FMTE^XLFDT($$NOW^XLFDT)
- +7 SET LN=LN+1
- SET ^TMP($JOB,"RCMMSG",LN,0)="The user: "_$$GET1^DIQ(200,DUZ_",",.01)_" (User #"_DUZ_")"
- +8 SET LN=LN+1
- SET ^TMP($JOB,"RCMMSG",LN,0)=" "
- SET LN=LN+1
- SET ^TMP($JOB,"RCMMSG",LN,0)="Deleted Lockbox Message Information: "
- +9 ; add data and field labels to message
- +10 FOR J=.01:.01:.04,.07:.01:.15
- Begin DoDot:1
- +11 ; skip null fields
- SET X=$GET(RCDPDATA(344.5,RCLKBXDA,J,"E"))
- if X=""
- QUIT
- +12 SET LN=LN+1
- SET ^TMP($JOB,"RCMMSG",LN,0)=" > "_$$GET1^DID(344.5,J,"","LABEL")_": "_X
- End DoDot:1
- +13 ; send as a priority message
- +14 SET XMTO(DUZ)=""
- SET XMTO("G.RCDPE PAYMENTS MGMT")=""
- SET XMINSTR("FLAGS")="P"
- +15 DO SENDMSG^XMXAPI(DUZ,"EDI LOCKBOX MESSAGE DELETION",$NAME(^TMP($JOB,"RCMMSG")),.XMTO,.XMINSTR,.XMZ)
- +16 IF '$GET(ZTSK)
- IF $EXTRACT(IOST,1,2)="C-"
- IF $GET(XMZ)
- WRITE !,"MailMan message #"_XMZ_" sent."
- +17 KILL ^TMP($JOB,"RCMMSG")
- +18 QUIT
- +19 ;
- LKBXDEL(RCLKBXDA) ;Delete entry from AR EDI LOCKBOX MESSAGES file
- +1 NEW DA,DIC,DIK,X,Y
- SET DIK="^RCY(344.5,"
- SET DA=RCLKBXDA
- DO ^DIK
- +2 QUIT
- +3 ;
- TASK(RCRTN,RCLKBXDA) ;function, Schedule the task to update data base from message
- +1 ; RCRTN - routine to task
- +2 ; RCLKBXDA - IEN in file 344.5
- +3 ; returns: TaskMan task #
- +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,RCLKBXDA,0))
- Begin DoDot:1
- +8 SET DIE="^RCY(344.5,"
- SET DR=".05///"_ZTSK_";.04///1;.08///0"
- SET DA=RCLKBXDA
- DO ^DIE
- End DoDot:1
- +9 QUIT $GET(ZTSK)
- +10 ;
- LOCK(RCLKBXDA) ; Boolean function, lock entry RCLKBXDA in file 344.5
- +1 ; Return 1 if successful, else zero
- +2 ; error message is also false
- if '($GET(RCLKBXDA)>0)
- QUIT "^no 344.5 IEN to lock"
- +3 NEW LCK
- LOCK +^RCY(344.5,RCLKBXDA,0):DILOCKTM
- SET LCK=$TEST
- +4 QUIT LCK
- +5 ;
- 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^RCDPEX(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 - DUPLICATE ERA - 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
