RCDPEX31 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;Jun 11, 2014@15:50:59
;;4.5;Accounts Receivable;**173,208,298,321,409**;Mar 20, 1995;Build 17
;Per VA Directive 6402, this routine should not be modified.
;
UPD ; Try to update the IB EOB file from exception in 344.41
N RCDA,RCTDA,RCTDA1,RCWHY,Z,DA,DIE,DR
D FULL^VALM1
D SEL^RCDPEX3(.RCDA,1)
S RCDA=$O(RCDA(0)) G:'RCDA UPDQ
S RCTDA=+RCDA(RCDA),RCTDA1=+$P(RCDA(RCDA),U,2)
I '$$LOCK(RCTDA,RCTDA1,0) G UPDQ
I $P($G(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,7)'=2 D G UPDQ
. W !,"EEOB cannot be filed in IB"_$S($P($G(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,7)=1:" - the bill # is invalid",1:"")
. D PAUSE^VALM1
I RCTDA,RCTDA1 D UPDEOB^RCDPESR2(RCTDA_";"_RCTDA1,4)
S Z=$P($G(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,2)
I Z D ; Update file 344.41 record
. S DA(1)=RCTDA,DA=RCTDA1,DR=".07///@;.13////1;.02////"_Z,DIE="^RCY(344.4,"_DA(1)_",1," D ^DIE
W !,"EEOB DETAIL UPDATE ",$S(Z:"WAS SUCCESSFUL",1:"ENCOUNTERED ERRORS")
S RCWHY(1)="Update IB with EEOB detail",RCWHY(2)="Update EEOB detail was "_$S('Z:"NOT",1:"")_" successful"
D STORACT(RCTDA,RCTDA1,.RCWHY)
D PAUSE^VALM1
D BLD^RCDPEX2
;
UPDQ S VALMBCK="R"
Q
;
; PRCA*4.5*409 Added entry point
REMEXC(ERA,REASON,NOMESS) ;EP from RCDPEM2@RETN, RCP409
; Remove any existing Data Exception for any EOBs of the specified ERA
; Input: ERA - ERA to removed data exceptions from
; REASON - Reason ERA was removed from the worklist
; NOMESS - 1 to not display locked warning message, 0 otherwise
; optiona, defaults to 0
N EOB,NOLOCK,RCDA,RCTDA,RCTDA1,XX,ZZ
Q:ERA=""
S:'$D(NOMESS) NOMESS=0
S XX=ERA_"^^"_REASON
S EOB=0,NOLOCK=0 ; Assume we can lock all EOBs
F D Q:'EOB
. S EOB=$O(^RCY(344.4,ERA,1,EOB))
. Q:'EOB
. Q:$P(^RCY(344.4,ERA,1,EOB,0),"^",7)="" ; EOB is not on the Data Exceptions list
. S $P(XX,"^",2)=EOB
. S RCDA(1)=ERA_"^"_EOB
. S RCDA=$O(RCDA(""))
. S RCTDA=+RCDA(RCDA),RCTDA1=$P(RCDA(RCDA),U,2)
. I '$$LOCK(RCTDA,RCTDA1,1) S NOLOCK=1 Q ; Couldn't lock EOB
. D DEL2(RCTDA,RCTDA1,REASON) ; Remove data exception for EOB
. L -^RCY(344.4,RCTDA,1,RCTDA1,0) ; Unlock the EOB
. K RCDA,RCDTA,RCDTA1
;
I 'NOMESS,NOLOCK D Q
. W !!,*7,"Warning: Not all of the data exceptions could be removed."
. W !,"Please manually remove any remaining data exceptions for this ERA."
. D PAUSE^VALM1
Q
;
DEL ; Delete exception conditions from EOB detail list - file 344.4
N DIR,DA,DIE,DR,DTOUT,DUOUT,RCT,RCTDA,RCTDA1,X,Y,Z
D FULL^VALM1
D SEL^RCDPEX3(.RCDA,1)
S RCDA=$O(RCDA(""))
I RCDA="" D DELQ Q
S RCTDA=+RCDA(RCDA),RCTDA1=$P(RCDA(RCDA),U,2)
I '$$LOCK(RCTDA,RCTDA1,0) D DELQ Q
W !
S DIR(0)="YA"
S DIR("A",1)="This action will mark this EEOB detail record so it no longer appears as an"
S DIR("A",2)="exception. A MailMan message will be sent to report this action."
S DIR("A",3)=" "
S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
D ^DIR K DIR
I Y'=1 D DELQ Q
;
S DIR(0)="FA;3:60"
S DIR("A")="ENTER A REASON FOR THIS ACTION: "
S DIR("?",1)="Enter the reason why this EEOB exception is being removed from the"
S DIR("?")=" exception list (3-60 characters are REQUIRED)"
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) D DELQ Q
D DEL2(RCTDA,RCTDA1,Y) ; PRCA*4.5*409 added line
W !,"A MailMan message has been sent to report this action.",!
D PAUSE^VALM1
D BLD^RCDPEX2
D DELQ
Q
;
DEL2(RCTDA,RCTDA1,REASON) ; Unflag the EOB as a data exception
; PRCA*4.5*409 This is a new method that was previously part of th DEL method above
; It was broken out so that it could be called by new method REMEXC
; to unflag a data exception without any messages to the screen or user input
; Input: RCTDA - ERA IEN of the EOB to be unflagged
; RCTDA1 - IEN of the EOB to be unflagged
; REASON - Reason why the EOB was unflagged
N DA,RC0,RC00,RCDIQ,RCDIQ1,RCE,RCT,RCWHY,RCWHYTXT,RCX,Z
S RCWHY(1)="Removal of EEOB detail entry from the exception list"
S RCWHY(2)=" Reason Entered: "_REASON,RCWHYTXT=REASON
S RC0=$G(^RCY(344.4,RCTDA,0)),RC00=$G(^(1,RCTDA1,0))
;
D GETS^DIQ(344.4,RCTDA_",","*","IEN","RCDIQ")
D GETS^DIQ(344.41,RCTDA1_","_RCTDA_",","*","IEN","RCDIQ1")
S RCE=0
D TXT0(RCTDA,.RCDIQ,.RCX,.RCE)
S RCE=RCE+1,RCX(RCE)="RAW MESSAGE DATA:"
D TXT00(RCTDA,RCTDA1,.RCDIQ1,.RCX,.RCE)
S DA=RCTDA1,DA(1)=RCTDA,DR=".07///@;.13////0",DIE="^RCY(344.4,"_DA(1)_",1,"
D ^DIE
D STORACT(RCTDA,RCTDA1,.RCWHY)
;
; Removed the sending of mailman message about the removed data exception
; since prior to a just made bug fix (see SENDMSG^XMXAPI line below) no
; mailman messages were being sent and eBusiness decided not to fix the bug.
Q ; PRCA*4.5*409 Added line
;
S RCT(1)="The electronic EEOB detail for Trace #: "
S RCT(1)=RCT(1)_$P(RC0,U,2)_" and Seq #"
S RCT(1)=RCT(1)_$P(RC00,U)
S RCT(2)=" is no longer flagged for an exception condition"
S RCT(3)="PAYMENT FROM: "_$P(RC0,U,6)_" on "_$$FMTE^XLFDT($P(RC0,U,4),2)
S RCT(4)=" "
S RCT(5)="REASON: "_RCWHYTXT
S RCT(6)="ACTION PERFORMED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
S RCT(7)=" ",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)=" "
D ; send MailMan message
. N XMBODY,XMINSTR,XMSUBJ,XMZ
. S XMSUBJ="EDI LBOX EEOB DETAIL EXCEPTION REMOVED"
. S XMBODY="RCT",XMTO("G.RCDPE PAYMENTS")=""
. S XMTO(DUZ)="",XMINSTR("FROM")="POSTMASTER"
. D SENDMSG^XMXAPI(DUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMZ) ;PRCA*4.5*409 Changed .5, to DUZ,
Q
;
DELQ ; Unlock EOB (if locked) and refresh the listman screen
I $G(RCTDA),$G(RCTDA1) L -^RCY(344.4,RCTDA,1,RCTDA1,0)
S VALMBCK="R"
Q
;
TXT0(RCTDA,RCDIQ,RCXM1,RC) ; Append 0-node captioned data to array RCXM1
; which is then used to populate the body of a mailman message which
; contains the detail of which EOB was unflagged
; Input: RCTDA - ERA IEN of the EOB that is being unflagged
; RCDIQ - Array of fields from ^RCY(344.4,RCTDA)
; RCXM1 - Current Array of text
; RC - Current line counter for the RCXM1 array
; Output: RCXM1 - Updated Array of text
; RC - Updated line counter for the RCXM1 array
;
N DAT,LINE,Z,Z0,Z1
S LINE="",RC=+$G(RC)
S RC=RC+1,RCXM1(RC)=" **ERA SUMMARY DATA**"
S Z=0 F S Z=$O(RCDIQ(344.4,RCTDA_",",Z)) Q:'Z D ;prca*4.5*298 need to get additional fields for display
. I $G(RCDIQ(344.4,RCTDA_",",Z,"E"))="" Q
. S Z0=$$GET1^DID(344.4,Z,,"LABEL")
. S DAT=Z0_": "_$G(RCDIQ(344.4,RCTDA_",",Z,"E"))
. I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
. I $L(LINE) D Q:LINE="" ; Left side exists
. . I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
. . S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
. S LINE=$E(DAT_$J("",39),1,39)
I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
S:RC RC=RC+1,RCXM1(RC)=" "
Q
;
TXT00(RCTDA,RCTDA1,RCDIQ1,RCXM1,RC) ; Extract 0-node data for file 344.41
; which is then used to populate the body of a mailman message which
; contains the detail of which EOB was unflagged
; Input: RCTDA - ERA IEN of the EOB that is being unflagged
; RCTDA1 - EOB IEN of the EOB that is being unflagged
; RCDIQ1 - Array of fields from EOB subfile 344.4
; RCXM1 - Current Array of text
; RC - Current line counter for the RCXM1 array
; Output: RCXM1 - Updated Array of text
; RC - Updated line counter for the RCXM1 array
;
N DAT,RCT,LINE,Z,Z0,Z1
S LINE="",RC=+$G(RC)
S RC=RC+1,RCXM1(RC)=" **EEOB DETAIL DATA**",RCT=RCTDA1_","_RCTDA_","
S Z=0
F S Z=$O(RCDIQ1(344.41,RCT,Z)) Q:'Z D ;prca*4.5*298 need to get additional fields for display
. I (Z'=.25),$G(RCDIQ1(344.41,RCT,Z,"E"))="" Q ;prca*4.5*298 even if RECEIPT # (.25) is null, display the label
. I (Z=1)!(Z=2) Q ; Suppress display of RAW DATA and EXCEPTION LOG field - PRCA*4.5*321
. S Z0=$$GET1^DID(344.41,Z,,"LABEL")
. S DAT=Z0_": "_$G(RCDIQ1(344.41,RCT,Z,"E"))
. ; PRCA*4.5*321 - END
. I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
. I $L(LINE) D Q:LINE="" ; Left side exists
. . I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
. . S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
. S LINE=$E(DAT_$J("",39),1,39)
I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
S:RC RC=RC+1,RCXM1(RC)=" "
Q
;
TXT2(RCTDA,RCTDA1,RCDIQ2,RCXM1,RC) ; Extract all data from subfile ^RCY(344.4,RCTDA,2,0)
; Input: RCTDA - ERA IEN of the EOB that is being unflagged
; RCTDA1 - EOB IEN of the EOB that is being unflagged
; RCDIQ2 - Array of fields from ^RCY(344.4,RCTDA,2,0)
; RCXM1 - Current Array of text
; RC - Current line counter for the RCXM1 array
; Output: RCXM1 - Updated Array of text
; RC - Updated line counter for the RCXM1 array
;
N RCT,LINE,DAT,Z,Z0
S LINE="",RC=+$G(RC)
S RCT=RCTDA1_","_RCTDA_","
S Z=0 F S Z=$O(RCDIQ2(344.42,RCT,Z)) Q:'Z D
. I $G(RCDIQ2(344.42,RCT,Z,"E"))="" Q
. S Z0=$$GET1^DID(344.42,Z,,"LABEL")
. S DAT=Z0_": "_$G(RCDIQ2(344.42,RCT,Z,"E"))
. I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
. I $L(LINE) D Q:LINE="" ; Left side exists
.. I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
.. S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
. S LINE=$E(DAT_$J("",39),1,39)
I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
S:RC RC=RC+1,RCXM1(RC)=" "
Q
;
LOCK(RCTDA,RCTDA1,RCSHH) ; Attempt to lock file entry in file 344.41
; Return 1 if successful, 0 if not able to lock
; Input: RCTDA - ERA IEN of the EOB line being locked
; RCTDA1 - EOB IEN of the EOB line being locked
; RCSHH - Optiona1, 1 if there should be no direct writes
;
N OK
S OK=1
L +^RCY(344.4,RCTDA,1,RCTDA1,0):5
I '$T D
. I '$D(DIQUIET),'$G(RCSHH) D
. . W !,*7,"Another user is editing this entry ... please try again later"
. . D PAUSE^VALM1
. S OK=0
Q OK
;
STORACT(RCTDA,RCTDA1,RCWHY) ; Store the detail for the action taken for
; the exception record at ^RCY(344.4,RCTDA,1,RCTDA,0)
; Input: RCTDA - ERA IEN of the EOB line being locked
; RCTDA1 - EOB IEN of the EOB line being locked
; RCWHY(#)- Lines containing the reason/explanation for the action
; RCWHY(1)- Should contain the description of the action taken
; It will be appended to the first line of the message after
; the date and user who made the change.
;
N RC,RCDA,RCTXT,Z
S RCDA(1)=RCTDA,RCDA=RCTDA1
S RCTXT(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$P($G(^VA(200,+DUZ,0)),U)_" "_$G(RCWHY(1))
S (RC,Z)=1
F S Z=$O(RCWHY(Z)) Q:'Z S RC=RC+1,RCTXT(RC)=" "_RCWHY(Z)
D WP^DIE(344.41,$$IENS^DILF(.RCDA),2,"A","RCTXT")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEX31 11218 printed Dec 13, 2024@01:45:58 Page 2
RCDPEX31 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;Jun 11, 2014@15:50:59
+1 ;;4.5;Accounts Receivable;**173,208,298,321,409**;Mar 20, 1995;Build 17
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
UPD ; Try to update the IB EOB file from exception in 344.41
+1 NEW RCDA,RCTDA,RCTDA1,RCWHY,Z,DA,DIE,DR
+2 DO FULL^VALM1
+3 DO SEL^RCDPEX3(.RCDA,1)
+4 SET RCDA=$ORDER(RCDA(0))
if 'RCDA
GOTO UPDQ
+5 SET RCTDA=+RCDA(RCDA)
SET RCTDA1=+$PIECE(RCDA(RCDA),U,2)
+6 IF '$$LOCK(RCTDA,RCTDA1,0)
GOTO UPDQ
+7 IF $PIECE($GET(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,7)'=2
Begin DoDot:1
+8 WRITE !,"EEOB cannot be filed in IB"_$SELECT($PIECE($GET(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,7)=1:" - the bill # is invalid",1:"")
+9 DO PAUSE^VALM1
End DoDot:1
GOTO UPDQ
+10 IF RCTDA
IF RCTDA1
DO UPDEOB^RCDPESR2(RCTDA_";"_RCTDA1,4)
+11 SET Z=$PIECE($GET(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,2)
+12 ; Update file 344.41 record
IF Z
Begin DoDot:1
+13 SET DA(1)=RCTDA
SET DA=RCTDA1
SET DR=".07///@;.13////1;.02////"_Z
SET DIE="^RCY(344.4,"_DA(1)_",1,"
DO ^DIE
End DoDot:1
+14 WRITE !,"EEOB DETAIL UPDATE ",$SELECT(Z:"WAS SUCCESSFUL",1:"ENCOUNTERED ERRORS")
+15 SET RCWHY(1)="Update IB with EEOB detail"
SET RCWHY(2)="Update EEOB detail was "_$SELECT('Z:"NOT",1:"")_" successful"
+16 DO STORACT(RCTDA,RCTDA1,.RCWHY)
+17 DO PAUSE^VALM1
+18 DO BLD^RCDPEX2
+19 ;
UPDQ SET VALMBCK="R"
+1 QUIT
+2 ;
+3 ; PRCA*4.5*409 Added entry point
REMEXC(ERA,REASON,NOMESS) ;EP from RCDPEM2@RETN, RCP409
+1 ; Remove any existing Data Exception for any EOBs of the specified ERA
+2 ; Input: ERA - ERA to removed data exceptions from
+3 ; REASON - Reason ERA was removed from the worklist
+4 ; NOMESS - 1 to not display locked warning message, 0 otherwise
+5 ; optiona, defaults to 0
+6 NEW EOB,NOLOCK,RCDA,RCTDA,RCTDA1,XX,ZZ
+7 if ERA=""
QUIT
+8 if '$DATA(NOMESS)
SET NOMESS=0
+9 SET XX=ERA_"^^"_REASON
+10 ; Assume we can lock all EOBs
SET EOB=0
SET NOLOCK=0
+11 FOR
Begin DoDot:1
+12 SET EOB=$ORDER(^RCY(344.4,ERA,1,EOB))
+13 if 'EOB
QUIT
+14 ; EOB is not on the Data Exceptions list
if $PIECE(^RCY(344.4,ERA,1,EOB,0),"^",7)=""
QUIT
+15 SET $PIECE(XX,"^",2)=EOB
+16 SET RCDA(1)=ERA_"^"_EOB
+17 SET RCDA=$ORDER(RCDA(""))
+18 SET RCTDA=+RCDA(RCDA)
SET RCTDA1=$PIECE(RCDA(RCDA),U,2)
+19 ; Couldn't lock EOB
IF '$$LOCK(RCTDA,RCTDA1,1)
SET NOLOCK=1
QUIT
+20 ; Remove data exception for EOB
DO DEL2(RCTDA,RCTDA1,REASON)
+21 ; Unlock the EOB
LOCK -^RCY(344.4,RCTDA,1,RCTDA1,0)
+22 KILL RCDA,RCDTA,RCDTA1
End DoDot:1
if 'EOB
QUIT
+23 ;
+24 IF 'NOMESS
IF NOLOCK
Begin DoDot:1
+25 WRITE !!,*7,"Warning: Not all of the data exceptions could be removed."
+26 WRITE !,"Please manually remove any remaining data exceptions for this ERA."
+27 DO PAUSE^VALM1
End DoDot:1
QUIT
+28 QUIT
+29 ;
DEL ; Delete exception conditions from EOB detail list - file 344.4
+1 NEW DIR,DA,DIE,DR,DTOUT,DUOUT,RCT,RCTDA,RCTDA1,X,Y,Z
+2 DO FULL^VALM1
+3 DO SEL^RCDPEX3(.RCDA,1)
+4 SET RCDA=$ORDER(RCDA(""))
+5 IF RCDA=""
DO DELQ
QUIT
+6 SET RCTDA=+RCDA(RCDA)
SET RCTDA1=$PIECE(RCDA(RCDA),U,2)
+7 IF '$$LOCK(RCTDA,RCTDA1,0)
DO DELQ
QUIT
+8 WRITE !
+9 SET DIR(0)="YA"
+10 SET DIR("A",1)="This action will mark this EEOB detail record so it no longer appears as an"
+11 SET DIR("A",2)="exception. A MailMan message will be sent to report this action."
+12 SET DIR("A",3)=" "
+13 SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? "
SET DIR("B")="NO"
+14 DO ^DIR
KILL DIR
+15 IF Y'=1
DO DELQ
QUIT
+16 ;
+17 SET DIR(0)="FA;3:60"
+18 SET DIR("A")="ENTER A REASON FOR THIS ACTION: "
+19 SET DIR("?",1)="Enter the reason why this EEOB exception is being removed from the"
+20 SET DIR("?")=" exception list (3-60 characters are REQUIRED)"
+21 DO ^DIR
KILL DIR
+22 IF $DATA(DUOUT)!$DATA(DTOUT)
DO DELQ
QUIT
+23 ; PRCA*4.5*409 added line
DO DEL2(RCTDA,RCTDA1,Y)
+24 WRITE !,"A MailMan message has been sent to report this action.",!
+25 DO PAUSE^VALM1
+26 DO BLD^RCDPEX2
+27 DO DELQ
+28 QUIT
+29 ;
DEL2(RCTDA,RCTDA1,REASON) ; Unflag the EOB as a data exception
+1 ; PRCA*4.5*409 This is a new method that was previously part of th DEL method above
+2 ; It was broken out so that it could be called by new method REMEXC
+3 ; to unflag a data exception without any messages to the screen or user input
+4 ; Input: RCTDA - ERA IEN of the EOB to be unflagged
+5 ; RCTDA1 - IEN of the EOB to be unflagged
+6 ; REASON - Reason why the EOB was unflagged
+7 NEW DA,RC0,RC00,RCDIQ,RCDIQ1,RCE,RCT,RCWHY,RCWHYTXT,RCX,Z
+8 SET RCWHY(1)="Removal of EEOB detail entry from the exception list"
+9 SET RCWHY(2)=" Reason Entered: "_REASON
SET RCWHYTXT=REASON
+10 SET RC0=$GET(^RCY(344.4,RCTDA,0))
SET RC00=$GET(^(1,RCTDA1,0))
+11 ;
+12 DO GETS^DIQ(344.4,RCTDA_",","*","IEN","RCDIQ")
+13 DO GETS^DIQ(344.41,RCTDA1_","_RCTDA_",","*","IEN","RCDIQ1")
+14 SET RCE=0
+15 DO TXT0(RCTDA,.RCDIQ,.RCX,.RCE)
+16 SET RCE=RCE+1
SET RCX(RCE)="RAW MESSAGE DATA:"
+17 DO TXT00(RCTDA,RCTDA1,.RCDIQ1,.RCX,.RCE)
+18 SET DA=RCTDA1
SET DA(1)=RCTDA
SET DR=".07///@;.13////0"
SET DIE="^RCY(344.4,"_DA(1)_",1,"
+19 DO ^DIE
+20 DO STORACT(RCTDA,RCTDA1,.RCWHY)
+21 ;
+22 ; Removed the sending of mailman message about the removed data exception
+23 ; since prior to a just made bug fix (see SENDMSG^XMXAPI line below) no
+24 ; mailman messages were being sent and eBusiness decided not to fix the bug.
+25 ; PRCA*4.5*409 Added line
QUIT
+26 ;
+27 SET RCT(1)="The electronic EEOB detail for Trace #: "
+28 SET RCT(1)=RCT(1)_$PIECE(RC0,U,2)_" and Seq #"
+29 SET RCT(1)=RCT(1)_$PIECE(RC00,U)
+30 SET RCT(2)=" is no longer flagged for an exception condition"
+31 SET RCT(3)="PAYMENT FROM: "_$PIECE(RC0,U,6)_" on "_$$FMTE^XLFDT($PIECE(RC0,U,4),2)
+32 SET RCT(4)=" "
+33 SET RCT(5)="REASON: "_RCWHYTXT
+34 SET RCT(6)="ACTION PERFORMED BY: "_$PIECE($GET(^VA(200,+$GET(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
+35 SET RCT(7)=" "
SET RCE=+$ORDER(RCT(""),-1)
+36 SET Z=0
+37 FOR
SET Z=$ORDER(RCX(Z))
if 'Z
QUIT
SET RCE=RCE+1
SET RCT(RCE)=RCX(Z)
+38 SET RCE=RCE+1
SET RCT(RCE)=" "
+39 ; send MailMan message
Begin DoDot:1
+40 NEW XMBODY,XMINSTR,XMSUBJ,XMZ
+41 SET XMSUBJ="EDI LBOX EEOB DETAIL EXCEPTION REMOVED"
+42 SET XMBODY="RCT"
SET XMTO("G.RCDPE PAYMENTS")=""
+43 SET XMTO(DUZ)=""
SET XMINSTR("FROM")="POSTMASTER"
+44 ;PRCA*4.5*409 Changed .5, to DUZ,
DO SENDMSG^XMXAPI(DUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMZ)
End DoDot:1
+45 QUIT
+46 ;
DELQ ; Unlock EOB (if locked) and refresh the listman screen
+1 IF $GET(RCTDA)
IF $GET(RCTDA1)
LOCK -^RCY(344.4,RCTDA,1,RCTDA1,0)
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
TXT0(RCTDA,RCDIQ,RCXM1,RC) ; Append 0-node captioned data to array RCXM1
+1 ; which is then used to populate the body of a mailman message which
+2 ; contains the detail of which EOB was unflagged
+3 ; Input: RCTDA - ERA IEN of the EOB that is being unflagged
+4 ; RCDIQ - Array of fields from ^RCY(344.4,RCTDA)
+5 ; RCXM1 - Current Array of text
+6 ; RC - Current line counter for the RCXM1 array
+7 ; Output: RCXM1 - Updated Array of text
+8 ; RC - Updated line counter for the RCXM1 array
+9 ;
+10 NEW DAT,LINE,Z,Z0,Z1
+11 SET LINE=""
SET RC=+$GET(RC)
+12 SET RC=RC+1
SET RCXM1(RC)=" **ERA SUMMARY DATA**"
+13 ;prca*4.5*298 need to get additional fields for display
SET Z=0
FOR
SET Z=$ORDER(RCDIQ(344.4,RCTDA_",",Z))
if 'Z
QUIT
Begin DoDot:1
+14 IF $GET(RCDIQ(344.4,RCTDA_",",Z,"E"))=""
QUIT
+15 SET Z0=$$GET1^DID(344.4,Z,,"LABEL")
+16 SET DAT=Z0_": "_$GET(RCDIQ(344.4,RCTDA_",",Z,"E"))
+17 IF $LENGTH(DAT)>39
if $LENGTH(LINE)
SET RC=RC+1
SET RCXM1(RC)=LINE
SET RC=RC+1
SET RCXM1(RC)=DAT
SET LINE=""
QUIT
+18 ; Left side exists
IF $LENGTH(LINE)
Begin DoDot:2
+19 IF $LENGTH(LINE)+$LENGTH(DAT)>75
SET RC=RC+1
SET RCXM1(RC)=LINE
SET LINE=DAT
QUIT
+20 SET LINE=LINE_" "_DAT
SET RC=RC+1
SET RCXM1(RC)=LINE
SET LINE=""
End DoDot:2
if LINE=""
QUIT
+21 SET LINE=$EXTRACT(DAT_$JUSTIFY("",39),1,39)
End DoDot:1
+22 IF $LENGTH(LINE)
SET RC=RC+1
SET RCXM1(RC)=LINE
+23 if RC
SET RC=RC+1
SET RCXM1(RC)=" "
+24 QUIT
+25 ;
TXT00(RCTDA,RCTDA1,RCDIQ1,RCXM1,RC) ; Extract 0-node data for file 344.41
+1 ; which is then used to populate the body of a mailman message which
+2 ; contains the detail of which EOB was unflagged
+3 ; Input: RCTDA - ERA IEN of the EOB that is being unflagged
+4 ; RCTDA1 - EOB IEN of the EOB that is being unflagged
+5 ; RCDIQ1 - Array of fields from EOB subfile 344.4
+6 ; RCXM1 - Current Array of text
+7 ; RC - Current line counter for the RCXM1 array
+8 ; Output: RCXM1 - Updated Array of text
+9 ; RC - Updated line counter for the RCXM1 array
+10 ;
+11 NEW DAT,RCT,LINE,Z,Z0,Z1
+12 SET LINE=""
SET RC=+$GET(RC)
+13 SET RC=RC+1
SET RCXM1(RC)=" **EEOB DETAIL DATA**"
SET RCT=RCTDA1_","_RCTDA_","
+14 SET Z=0
+15 ;prca*4.5*298 need to get additional fields for display
FOR
SET Z=$ORDER(RCDIQ1(344.41,RCT,Z))
if 'Z
QUIT
Begin DoDot:1
+16 ;prca*4.5*298 even if RECEIPT # (.25) is null, display the label
IF (Z'=.25)
IF $GET(RCDIQ1(344.41,RCT,Z,"E"))=""
QUIT
+17 ; Suppress display of RAW DATA and EXCEPTION LOG field - PRCA*4.5*321
IF (Z=1)!(Z=2)
QUIT
+18 SET Z0=$$GET1^DID(344.41,Z,,"LABEL")
+19 SET DAT=Z0_": "_$GET(RCDIQ1(344.41,RCT,Z,"E"))
+20 ; PRCA*4.5*321 - END
+21 IF $LENGTH(DAT)>39
if $LENGTH(LINE)
SET RC=RC+1
SET RCXM1(RC)=LINE
SET RC=RC+1
SET RCXM1(RC)=DAT
SET LINE=""
QUIT
+22 ; Left side exists
IF $LENGTH(LINE)
Begin DoDot:2
+23 IF $LENGTH(LINE)+$LENGTH(DAT)>75
SET RC=RC+1
SET RCXM1(RC)=LINE
SET LINE=DAT
QUIT
+24 SET LINE=LINE_" "_DAT
SET RC=RC+1
SET RCXM1(RC)=LINE
SET LINE=""
End DoDot:2
if LINE=""
QUIT
+25 SET LINE=$EXTRACT(DAT_$JUSTIFY("",39),1,39)
End DoDot:1
+26 IF $LENGTH(LINE)
SET RC=RC+1
SET RCXM1(RC)=LINE
+27 if RC
SET RC=RC+1
SET RCXM1(RC)=" "
+28 QUIT
+29 ;
TXT2(RCTDA,RCTDA1,RCDIQ2,RCXM1,RC) ; Extract all data from subfile ^RCY(344.4,RCTDA,2,0)
+1 ; Input: RCTDA - ERA IEN of the EOB that is being unflagged
+2 ; RCTDA1 - EOB IEN of the EOB that is being unflagged
+3 ; RCDIQ2 - Array of fields from ^RCY(344.4,RCTDA,2,0)
+4 ; RCXM1 - Current Array of text
+5 ; RC - Current line counter for the RCXM1 array
+6 ; Output: RCXM1 - Updated Array of text
+7 ; RC - Updated line counter for the RCXM1 array
+8 ;
+9 NEW RCT,LINE,DAT,Z,Z0
+10 SET LINE=""
SET RC=+$GET(RC)
+11 SET RCT=RCTDA1_","_RCTDA_","
+12 SET Z=0
FOR
SET Z=$ORDER(RCDIQ2(344.42,RCT,Z))
if 'Z
QUIT
Begin DoDot:1
+13 IF $GET(RCDIQ2(344.42,RCT,Z,"E"))=""
QUIT
+14 SET Z0=$$GET1^DID(344.42,Z,,"LABEL")
+15 SET DAT=Z0_": "_$GET(RCDIQ2(344.42,RCT,Z,"E"))
+16 IF $LENGTH(DAT)>39
if $LENGTH(LINE)
SET RC=RC+1
SET RCXM1(RC)=LINE
SET RC=RC+1
SET RCXM1(RC)=DAT
SET LINE=""
QUIT
+17 ; Left side exists
IF $LENGTH(LINE)
Begin DoDot:2
+18 IF $LENGTH(LINE)+$LENGTH(DAT)>75
SET RC=RC+1
SET RCXM1(RC)=LINE
SET LINE=DAT
QUIT
+19 SET LINE=LINE_" "_DAT
SET RC=RC+1
SET RCXM1(RC)=LINE
SET LINE=""
End DoDot:2
if LINE=""
QUIT
+20 SET LINE=$EXTRACT(DAT_$JUSTIFY("",39),1,39)
End DoDot:1
+21 IF $LENGTH(LINE)
SET RC=RC+1
SET RCXM1(RC)=LINE
+22 if RC
SET RC=RC+1
SET RCXM1(RC)=" "
+23 QUIT
+24 ;
LOCK(RCTDA,RCTDA1,RCSHH) ; Attempt to lock file entry in file 344.41
+1 ; Return 1 if successful, 0 if not able to lock
+2 ; Input: RCTDA - ERA IEN of the EOB line being locked
+3 ; RCTDA1 - EOB IEN of the EOB line being locked
+4 ; RCSHH - Optiona1, 1 if there should be no direct writes
+5 ;
+6 NEW OK
+7 SET OK=1
+8 LOCK +^RCY(344.4,RCTDA,1,RCTDA1,0):5
+9 IF '$TEST
Begin DoDot:1
+10 IF '$DATA(DIQUIET)
IF '$GET(RCSHH)
Begin DoDot:2
+11 WRITE !,*7,"Another user is editing this entry ... please try again later"
+12 DO PAUSE^VALM1
End DoDot:2
+13 SET OK=0
End DoDot:1
+14 QUIT OK
+15 ;
STORACT(RCTDA,RCTDA1,RCWHY) ; Store the detail for the action taken for
+1 ; the exception record at ^RCY(344.4,RCTDA,1,RCTDA,0)
+2 ; Input: RCTDA - ERA IEN of the EOB line being locked
+3 ; RCTDA1 - EOB IEN of the EOB line being locked
+4 ; RCWHY(#)- Lines containing the reason/explanation for the action
+5 ; RCWHY(1)- Should contain the description of the action taken
+6 ; It will be appended to the first line of the message after
+7 ; the date and user who made the change.
+8 ;
+9 NEW RC,RCDA,RCTXT,Z
+10 SET RCDA(1)=RCTDA
SET RCDA=RCTDA1
+11 SET RCTXT(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$PIECE($GET(^VA(200,+DUZ,0)),U)_" "_$GET(RCWHY(1))
+12 SET (RC,Z)=1
+13 FOR
SET Z=$ORDER(RCWHY(Z))
if 'Z
QUIT
SET RC=RC+1
SET RCTXT(RC)=" "_RCWHY(Z)
+14 DO WP^DIE(344.41,$$IENS^DILF(.RCDA),2,"A","RCTXT")
+15 QUIT
+16 ;
