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

RCDPEX31.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. UPD ; Try to update the IB EOB file from exception in 344.41
  1. N RCDA,RCTDA,RCTDA1,RCWHY,Z,DA,DIE,DR
  1. D FULL^VALM1
  1. D SEL^RCDPEX3(.RCDA,1)
  1. S RCDA=$O(RCDA(0)) G:'RCDA UPDQ
  1. S RCTDA=+RCDA(RCDA),RCTDA1=+$P(RCDA(RCDA),U,2)
  1. I '$$LOCK(RCTDA,RCTDA1,0) G UPDQ
  1. I $P($G(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,7)'=2 D G UPDQ
  1. . 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:"")
  1. . D PAUSE^VALM1
  1. I RCTDA,RCTDA1 D UPDEOB^RCDPESR2(RCTDA_";"_RCTDA1,4)
  1. S Z=$P($G(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,2)
  1. I Z D ; Update file 344.41 record
  1. . S DA(1)=RCTDA,DA=RCTDA1,DR=".07///@;.13////1;.02////"_Z,DIE="^RCY(344.4,"_DA(1)_",1," D ^DIE
  1. W !,"EEOB DETAIL UPDATE ",$S(Z:"WAS SUCCESSFUL",1:"ENCOUNTERED ERRORS")
  1. S RCWHY(1)="Update IB with EEOB detail",RCWHY(2)="Update EEOB detail was "_$S('Z:"NOT",1:"")_" successful"
  1. D STORACT(RCTDA,RCTDA1,.RCWHY)
  1. D PAUSE^VALM1
  1. D BLD^RCDPEX2
  1. ;
  1. UPDQ S VALMBCK="R"
  1. Q
  1. ;
  1. ; PRCA*4.5*409 Added entry point
  1. REMEXC(ERA,REASON,NOMESS) ;EP from RCDPEM2@RETN, RCP409
  1. ; Remove any existing Data Exception for any EOBs of the specified ERA
  1. ; Input: ERA - ERA to removed data exceptions from
  1. ; REASON - Reason ERA was removed from the worklist
  1. ; NOMESS - 1 to not display locked warning message, 0 otherwise
  1. ; optiona, defaults to 0
  1. N EOB,NOLOCK,RCDA,RCTDA,RCTDA1,XX,ZZ
  1. Q:ERA=""
  1. S:'$D(NOMESS) NOMESS=0
  1. S XX=ERA_"^^"_REASON
  1. S EOB=0,NOLOCK=0 ; Assume we can lock all EOBs
  1. F D Q:'EOB
  1. . S EOB=$O(^RCY(344.4,ERA,1,EOB))
  1. . Q:'EOB
  1. . Q:$P(^RCY(344.4,ERA,1,EOB,0),"^",7)="" ; EOB is not on the Data Exceptions list
  1. . S $P(XX,"^",2)=EOB
  1. . S RCDA(1)=ERA_"^"_EOB
  1. . S RCDA=$O(RCDA(""))
  1. . S RCTDA=+RCDA(RCDA),RCTDA1=$P(RCDA(RCDA),U,2)
  1. . I '$$LOCK(RCTDA,RCTDA1,1) S NOLOCK=1 Q ; Couldn't lock EOB
  1. . D DEL2(RCTDA,RCTDA1,REASON) ; Remove data exception for EOB
  1. . L -^RCY(344.4,RCTDA,1,RCTDA1,0) ; Unlock the EOB
  1. . K RCDA,RCDTA,RCDTA1
  1. ;
  1. I 'NOMESS,NOLOCK D Q
  1. . W !!,*7,"Warning: Not all of the data exceptions could be removed."
  1. . W !,"Please manually remove any remaining data exceptions for this ERA."
  1. . D PAUSE^VALM1
  1. Q
  1. ;
  1. DEL ; Delete exception conditions from EOB detail list - file 344.4
  1. N DIR,DA,DIE,DR,DTOUT,DUOUT,RCT,RCTDA,RCTDA1,X,Y,Z
  1. D FULL^VALM1
  1. D SEL^RCDPEX3(.RCDA,1)
  1. S RCDA=$O(RCDA(""))
  1. I RCDA="" D DELQ Q
  1. S RCTDA=+RCDA(RCDA),RCTDA1=$P(RCDA(RCDA),U,2)
  1. I '$$LOCK(RCTDA,RCTDA1,0) D DELQ Q
  1. W !
  1. S DIR(0)="YA"
  1. S DIR("A",1)="This action will mark this EEOB detail record so it no longer appears as an"
  1. S DIR("A",2)="exception. A MailMan message will be sent to report this action."
  1. S DIR("A",3)=" "
  1. S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
  1. D ^DIR K DIR
  1. I Y'=1 D DELQ Q
  1. ;
  1. S DIR(0)="FA;3:60"
  1. S DIR("A")="ENTER A REASON FOR THIS ACTION: "
  1. S DIR("?",1)="Enter the reason why this EEOB exception is being removed from the"
  1. S DIR("?")=" exception list (3-60 characters are REQUIRED)"
  1. D ^DIR K DIR
  1. I $D(DUOUT)!$D(DTOUT) D DELQ Q
  1. D DEL2(RCTDA,RCTDA1,Y) ; PRCA*4.5*409 added line
  1. W !,"A MailMan message has been sent to report this action.",!
  1. D PAUSE^VALM1
  1. D BLD^RCDPEX2
  1. D DELQ
  1. Q
  1. ;
  1. 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
  1. ; It was broken out so that it could be called by new method REMEXC
  1. ; to unflag a data exception without any messages to the screen or user input
  1. ; Input: RCTDA - ERA IEN of the EOB to be unflagged
  1. ; RCTDA1 - IEN of the EOB to be unflagged
  1. ; REASON - Reason why the EOB was unflagged
  1. N DA,RC0,RC00,RCDIQ,RCDIQ1,RCE,RCT,RCWHY,RCWHYTXT,RCX,Z
  1. S RCWHY(1)="Removal of EEOB detail entry from the exception list"
  1. S RCWHY(2)=" Reason Entered: "_REASON,RCWHYTXT=REASON
  1. S RC0=$G(^RCY(344.4,RCTDA,0)),RC00=$G(^(1,RCTDA1,0))
  1. ;
  1. D GETS^DIQ(344.4,RCTDA_",","*","IEN","RCDIQ")
  1. D GETS^DIQ(344.41,RCTDA1_","_RCTDA_",","*","IEN","RCDIQ1")
  1. S RCE=0
  1. D TXT0(RCTDA,.RCDIQ,.RCX,.RCE)
  1. S RCE=RCE+1,RCX(RCE)="RAW MESSAGE DATA:"
  1. D TXT00(RCTDA,RCTDA1,.RCDIQ1,.RCX,.RCE)
  1. S DA=RCTDA1,DA(1)=RCTDA,DR=".07///@;.13////0",DIE="^RCY(344.4,"_DA(1)_",1,"
  1. D ^DIE
  1. D STORACT(RCTDA,RCTDA1,.RCWHY)
  1. ;
  1. ; Removed the sending of mailman message about the removed data exception
  1. ; since prior to a just made bug fix (see SENDMSG^XMXAPI line below) no
  1. ; mailman messages were being sent and eBusiness decided not to fix the bug.
  1. Q ; PRCA*4.5*409 Added line
  1. ;
  1. S RCT(1)="The electronic EEOB detail for Trace #: "
  1. S RCT(1)=RCT(1)_$P(RC0,U,2)_" and Seq #"
  1. S RCT(1)=RCT(1)_$P(RC00,U)
  1. S RCT(2)=" is no longer flagged for an exception condition"
  1. S RCT(3)="PAYMENT FROM: "_$P(RC0,U,6)_" on "_$$FMTE^XLFDT($P(RC0,U,4),2)
  1. S RCT(4)=" "
  1. S RCT(5)="REASON: "_RCWHYTXT
  1. S RCT(6)="ACTION PERFORMED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
  1. S RCT(7)=" ",RCE=+$O(RCT(""),-1)
  1. S Z=0
  1. F S Z=$O(RCX(Z)) Q:'Z S RCE=RCE+1,RCT(RCE)=RCX(Z)
  1. S RCE=RCE+1,RCT(RCE)=" "
  1. D ; send MailMan message
  1. . N XMBODY,XMINSTR,XMSUBJ,XMZ
  1. . S XMSUBJ="EDI LBOX EEOB DETAIL EXCEPTION REMOVED"
  1. . S XMBODY="RCT",XMTO("G.RCDPE PAYMENTS")=""
  1. . S XMTO(DUZ)="",XMINSTR("FROM")="POSTMASTER"
  1. . D SENDMSG^XMXAPI(DUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMZ) ;PRCA*4.5*409 Changed .5, to DUZ,
  1. Q
  1. ;
  1. DELQ ; Unlock EOB (if locked) and refresh the listman screen
  1. I $G(RCTDA),$G(RCTDA1) L -^RCY(344.4,RCTDA,1,RCTDA1,0)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. 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
  1. ; contains the detail of which EOB was unflagged
  1. ; Input: RCTDA - ERA IEN of the EOB that is being unflagged
  1. ; RCDIQ - Array of fields from ^RCY(344.4,RCTDA)
  1. ; RCXM1 - Current Array of text
  1. ; RC - Current line counter for the RCXM1 array
  1. ; Output: RCXM1 - Updated Array of text
  1. ; RC - Updated line counter for the RCXM1 array
  1. ;
  1. N DAT,LINE,Z,Z0,Z1
  1. S LINE="",RC=+$G(RC)
  1. S RC=RC+1,RCXM1(RC)=" **ERA SUMMARY DATA**"
  1. 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
  1. . I $G(RCDIQ(344.4,RCTDA_",",Z,"E"))="" Q
  1. . S Z0=$$GET1^DID(344.4,Z,,"LABEL")
  1. . S DAT=Z0_": "_$G(RCDIQ(344.4,RCTDA_",",Z,"E"))
  1. . I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
  1. . I $L(LINE) D Q:LINE="" ; Left side exists
  1. . . I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
  1. . . S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
  1. . S LINE=$E(DAT_$J("",39),1,39)
  1. I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
  1. S:RC RC=RC+1,RCXM1(RC)=" "
  1. Q
  1. ;
  1. 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
  1. ; contains the detail of which EOB was unflagged
  1. ; Input: RCTDA - ERA IEN of the EOB that is being unflagged
  1. ; RCTDA1 - EOB IEN of the EOB that is being unflagged
  1. ; RCDIQ1 - Array of fields from EOB subfile 344.4
  1. ; RCXM1 - Current Array of text
  1. ; RC - Current line counter for the RCXM1 array
  1. ; Output: RCXM1 - Updated Array of text
  1. ; RC - Updated line counter for the RCXM1 array
  1. ;
  1. N DAT,RCT,LINE,Z,Z0,Z1
  1. S LINE="",RC=+$G(RC)
  1. S RC=RC+1,RCXM1(RC)=" **EEOB DETAIL DATA**",RCT=RCTDA1_","_RCTDA_","
  1. S Z=0
  1. F S Z=$O(RCDIQ1(344.41,RCT,Z)) Q:'Z D ;prca*4.5*298 need to get additional fields for display
  1. . I (Z'=.25),$G(RCDIQ1(344.41,RCT,Z,"E"))="" Q ;prca*4.5*298 even if RECEIPT # (.25) is null, display the label
  1. . I (Z=1)!(Z=2) Q ; Suppress display of RAW DATA and EXCEPTION LOG field - PRCA*4.5*321
  1. . S Z0=$$GET1^DID(344.41,Z,,"LABEL")
  1. . S DAT=Z0_": "_$G(RCDIQ1(344.41,RCT,Z,"E"))
  1. . ; PRCA*4.5*321 - END
  1. . I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
  1. . I $L(LINE) D Q:LINE="" ; Left side exists
  1. . . I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
  1. . . S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
  1. . S LINE=$E(DAT_$J("",39),1,39)
  1. I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
  1. S:RC RC=RC+1,RCXM1(RC)=" "
  1. Q
  1. ;
  1. 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
  1. ; RCTDA1 - EOB IEN of the EOB that is being unflagged
  1. ; RCDIQ2 - Array of fields from ^RCY(344.4,RCTDA,2,0)
  1. ; RCXM1 - Current Array of text
  1. ; RC - Current line counter for the RCXM1 array
  1. ; Output: RCXM1 - Updated Array of text
  1. ; RC - Updated line counter for the RCXM1 array
  1. ;
  1. N RCT,LINE,DAT,Z,Z0
  1. S LINE="",RC=+$G(RC)
  1. S RCT=RCTDA1_","_RCTDA_","
  1. S Z=0 F S Z=$O(RCDIQ2(344.42,RCT,Z)) Q:'Z D
  1. . I $G(RCDIQ2(344.42,RCT,Z,"E"))="" Q
  1. . S Z0=$$GET1^DID(344.42,Z,,"LABEL")
  1. . S DAT=Z0_": "_$G(RCDIQ2(344.42,RCT,Z,"E"))
  1. . I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
  1. . I $L(LINE) D Q:LINE="" ; Left side exists
  1. .. I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
  1. .. S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
  1. . S LINE=$E(DAT_$J("",39),1,39)
  1. I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
  1. S:RC RC=RC+1,RCXM1(RC)=" "
  1. Q
  1. ;
  1. LOCK(RCTDA,RCTDA1,RCSHH) ; Attempt to lock file entry in file 344.41
  1. ; Return 1 if successful, 0 if not able to lock
  1. ; Input: RCTDA - ERA IEN of the EOB line being locked
  1. ; RCTDA1 - EOB IEN of the EOB line being locked
  1. ; RCSHH - Optiona1, 1 if there should be no direct writes
  1. ;
  1. N OK
  1. S OK=1
  1. L +^RCY(344.4,RCTDA,1,RCTDA1,0):5
  1. I '$T D
  1. . I '$D(DIQUIET),'$G(RCSHH) D
  1. . . W !,*7,"Another user is editing this entry ... please try again later"
  1. . . D PAUSE^VALM1
  1. . S OK=0
  1. Q OK
  1. ;
  1. STORACT(RCTDA,RCTDA1,RCWHY) ; Store the detail for the action taken for
  1. ; the exception record at ^RCY(344.4,RCTDA,1,RCTDA,0)
  1. ; Input: RCTDA - ERA IEN of the EOB line being locked
  1. ; RCTDA1 - EOB IEN of the EOB line being locked
  1. ; RCWHY(#)- Lines containing the reason/explanation for the action
  1. ; RCWHY(1)- Should contain the description of the action taken
  1. ; It will be appended to the first line of the message after
  1. ; the date and user who made the change.
  1. ;
  1. N RC,RCDA,RCTXT,Z
  1. S RCDA(1)=RCTDA,RCDA=RCTDA1
  1. S RCTXT(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$P($G(^VA(200,+DUZ,0)),U)_" "_$G(RCWHY(1))
  1. S (RC,Z)=1
  1. F S Z=$O(RCWHY(Z)) Q:'Z S RC=RC+1,RCTXT(RC)=" "_RCWHY(Z)
  1. D WP^DIE(344.41,$$IENS^DILF(.RCDA),2,"A","RCTXT")
  1. Q
  1. ;