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

RCDPEWL.m

Go to the documentation of this file.
  1. RCDPEWL ;ALB/TMK/KML - ELECTRONIC EOB MESSAGE WORKLIST ;Jun 06, 2014@19:11:19
  1. ;;4.5;Accounts Receivable;**173,208,269,298,317,318,326,349,367**;Mar 20, 1995;Build 11
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ; IA for read access to ^IBM(361.1 = 4051
  1. ;
  1. EN ; Main entry point
  1. N RCFASTXT,DA,DIC,X,Y,RCERA,RCNOED,RCQUIT ;PRCA*4.5*317 Added RCQUIT
  1. D FULL^VALM1
  1. ;
  1. S DIR(0)="SA^L:LIST;S:SPECIFIC"
  1. S DIR("A")="Do you want a (L)IST of ERAs or a (S)PECIFIC one?: "
  1. S DIR("?",1)="Enter LIST to see a list of ERAs."
  1. S DIR("?")="Enter SPECIFIC to see a selected ERA."
  1. S DIR("B")="LIST"
  1. W !
  1. D ^DIR
  1. K DIR
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. I Y="S" D Q
  1. . S DIC="^RCY(344.4,",DIC(0)="AEMQ"
  1. . D ^DIC
  1. . I Y>0 D WL^RCDPEWL7(+Y)
  1. ;
  1. ; Calling Preferred View API in Menu Option Mode
  1. D PARAMS^RCDPEWL0("MO")
  1. Q:$G(RCQUIT)
  1. D EN^VALM("RCDPE WORKLIST ERA LIST")
  1. Q
  1. ;
  1. DISP(RCERA,RCNOED) ; Entry to worklist from receipt processing
  1. ; RCERA = ien of entry in file 344.49
  1. ; RCNOED = 1 if receipt exists/no editing allowed
  1. ; = 2 if no edit and called from receipt processing
  1. ; ; prca*4.5*298 - added AUTOPOST input argument
  1. ; AUTOPOST = "" if ERA is non-autopost
  1. ; = 0 if auto-posted ERA is in UNPOSTED status
  1. ; = 1 if auto-posted ERA is in PARTIAL posted status
  1. ; = 2 if auto-posted ERA is in COMPLETE status
  1. ;
  1. N DUOUT,DTOUT,DIC,DIK,X,Y,DIR,RCQUIT,DA,DIE,DR,RCSCR,RC0,RC5,RCDAT,RCTRACE,RCUNM
  1. ;
  1. S RCSCR("NOEDIT")=+$G(RCNOED)
  1. S RCQUIT=0,RC0=$G(^RCY(344.4,RCERA,0)),RC5=$G(^RCY(344.4,RCERA,5))
  1. S RCTRACE=$P(RC0,"^",2) ; PRCA*4.5*367 - Trace Number
  1. I 'RCSCR("NOEDIT"),'$O(^RCY(344.49,"B",RCERA,0)) D G:RCQUIT DISPQ
  1. . ;allow additional selections
  1. . S DIR("A",1)="No worklist scratchpad entry exists for this ERA."
  1. . S DIR("A")="(C)reate scratchpad, (V)iew ERA details or (E)xit:"
  1. . S DIR(0)="SAO^C:CREATE SCRATCHPAD;V:VIEW ERA DETAILS;E:EXIT"
  1. . W ! D ^DIR K DIR
  1. . I (Y'="V")&(Y'="C")&(Y'="E") S RCERA=-1,RCQUIT=1 Q
  1. . I Y="V" S RCSCR=RCERA D PRERA1^RCDPEWL0 S RCERA=-1,RCQUIT=1 Q
  1. . I Y="E" S RCERA=-1,RCQUIT=1 Q
  1. . ; prca*4.5*298 Y is = "C" therefore perform the pre-existing scratchpad creation/editing algorithm
  1. . I $P(RC0,U,15)'="" W !!,"PAYMENT METHOD CODE REPORTED: "_$P(RC0,U,15),!
  1. . I $P(RC0,U,15)="" W !!,"NO PAYMENT METHOD CODE REPORTED",!
  1. . I $P(RC0,U,9)=0,$P(RC5,U,2)="" D Q:RCQUIT
  1. .. S RCQUIT=0,RCUNM=0
  1. .. I +$P(RC0,U,5)=0,"ACH"'[(U_$P(RC0,U,15)_U) D Q:RCQUIT!RCUNM
  1. ... S DIR("A",1)="This ERA has no payment associated with it and can be marked as",DIR("A",2)="'MATCH-0 PAYMENT' to remove it from the ERA AGING REPORT if no paper check or",DIR("A",3)="EFT is expected to be received for this ERA"
  1. ... S DIR("?")="Do NOT respond YES here unless you are sure there will be no EFT or paper",DIR("?",1)=" check to be received for this 0-PAYMENT ERA"
  1. ... S DIR("A")="Do you want to do this?: "
  1. ... S DIR(0)="YA"
  1. ... D ^DIR K DIR
  1. ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
  1. ... I Y'=1 Q
  1. ... S DIE="^RCY(344.4,",DR=".09////3;.14////3",DA=RCERA D ^DIE S RCUNM=1
  1. .. ; PRCA*4.5*367 - Skip prompt for check number if the ERA is for a TDA
  1. .. I 'RCUNM,$$HACERA^RCDPEU(RCERA) D
  1. ... W !!,"This ERA does NOT have a matching EFT"
  1. ... W !,"ERA #",RCERA," (TRACE #"_RCTRACE_") matched to TDA ",RCTRACE
  1. ... S DIR("A")="Has the TDA been received by FMS?: ",DIR("B")="YES"
  1. ... S DIR(0)="YA" D ^DIR K DIR
  1. ... I $D(DTOUT)!$D(DUOUT)!'Y S RCQUIT=1 Q
  1. ... ;
  1. ... ; Null check number field but file date matched and USER
  1. ... S DIE="^RCY(344.4,",DA=RCERA
  1. ... S DR=".13////@;.09////5;5.03///"_$$DT^XLFDT()_";5.04///"_$G(DUZ)
  1. ... D ^DIE
  1. .. E I 'RCUNM D
  1. ... S DIR("A",1)="This ERA does NOT have a matching EFT",DIR("A")="Enter the number of the paper check you received for this ERA: ",DIR(0)="344.01,.07A"
  1. ... I $P(RC5,U,2)'="" S DIR("B")=$P(RC5,U,2)
  1. ... I $G(DIR("B"))="",$P(RC0,U,2)'="" S DIR("B")=$P(RC0,U,2)
  1. ... W ! D ^DIR K DIR
  1. ... I $D(DTOUT)!$D(DUOUT)!(Y="") D S RCQUIT=1 Q
  1. .... S DIR(0)="EA",DIR("A",1)="There must be either a paper check or an EFT for this ERA",DIR("A")="PRESS RETURN TO CONTINUE " W !! D ^DIR K DIR
  1. ... S RCDAT("CHECK#")=Y
  1. ... S DIR(0)="344.01,.1O",DIR("B")=$$FMTE^XLFDT($P(RC0,U,4),2)
  1. ... W ! D ^DIR K DIR
  1. ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
  1. ... S RCDAT("CHECKDT")=Y
  1. ... S DIR(0)="344.01,.08O"
  1. ... W ! D ^DIR K DIR
  1. ... I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
  1. ... S RCDAT("BANK")=Y
  1. ... S DIR("A",1)="ERA #"_RCERA_" (TRACE #:"_$P(RC0,U,2)_") matched to paper check "_RCDAT("CHECK#"),DIR("A")="Is this correct?: ",DIR(0)="YA",DIR("B")="YES" W ! D ^DIR K DIR
  1. ... I Y'=1 S RCQUIT=1 Q
  1. ... S DIE="^RCY(344.4,",DA=RCERA
  1. ... ; PRCA*4.5*326 - Add date matched and user for check match
  1. ... S DR=".13////"_RCDAT("CHECK#")_";.09////2;5.03///"_$$DT^XLFDT()_";5.04///"_$G(DUZ)
  1. ... D ^DIE
  1. ;
  1. S RCSCR=+$O(^RCY(344.49,"B",RCERA,0))
  1. I 'RCSCR D ; Build the entry in file 344.49
  1. . I RCSCR("NOEDIT") D Q
  1. .. S DIR("A")="NO worklist entry exists for this ERA - PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR
  1. . ;
  1. . S RCSCR=+$$ADDREC(RCERA,.RCDAT)
  1. . I RCSCR D Q:'RCSCR
  1. .. F X=1:1:6 L +^RCY(344.4,RCSCR):5 Q:$T I X=6 D Q
  1. ... S DA=RCSCR,DIK="^RCY(344.49," D ^DIK S RCSCR=0
  1. ... S DIR(0)="EA",DIR("A",1)="Another user has locked this entry - NEW RECORD NOT CREATED",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
  1. .. Q:'RCSCR
  1. .. ; prca*4.5*298 per patch requirements, keep code related to
  1. .. ; creating/maintaining batches but just remove from execution.
  1. .. ;D SETBATCH^RCDPEWLB(RCSCR) ; prca*4.5*298
  1. .. D ADDLINES^RCDPEWLA(RCSCR)
  1. .. K ^TMP($J,"BATCHES")
  1. ;
  1. I RCSCR D G:'RCSCR DISPQ
  1. . ; prca*4.5*298 per patch requirements, keep code related to
  1. . ; creating/maintaining batches but just remove from execution.
  1. . ;Q:'$$BAT^RCDPEWL7(RCSCR)
  1. . ;I 'RCSCR("NOEDIT"),'$G(^TMP("RCBATCH_SELECTED",$J)) L +^RCY(344.4,RCSCR):5 I '$T W !!,"Another user is currently editing this entry",! S DIR(0)="E" D ^DIR K DIR S RCSCR=0 Q
  1. . I 'RCSCR("NOEDIT") L +^RCY(344.4,RCSCR):5 I '$T W !!,"Another user is currently editing this entry",! S DIR(0)="E" D ^DIR K DIR S RCSCR=0 Q
  1. . D EN^VALM("RCDPE EOB WORKLIST")
  1. ;
  1. DISPQ L -^RCY(344.4,+$G(RCERA))
  1. Q
  1. ;
  1. INIT ; -- set up initial variables
  1. N RCQUIT,RCREV
  1. S VALMCNT=0,VALMBG=1
  1. S RCQUIT=0
  1. ; PRCA*4.5*298: Removed functionality for retrieving/storing user preferences in file #344.49
  1. ; and replaced with the use of parameters handled by PARAMS^RCDPEWLA.
  1. D PARAMS^RCDPEWLA("MO") I $G(RCQUIT) S VALMQUIT=1 Q
  1. D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
  1. Q
  1. ;
  1. CV ; Change View Action for EEOB Worklist
  1. D FULL^VALM1
  1. D PARAMS^RCDPEWLA("CV")
  1. D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM"))),HDR
  1. S VALMBCK="R",VALMBG=1
  1. Q
  1. ;
  1. ADDREC(RCERA,RCDAT) ; Add a record to file 344.49
  1. ; RCERA = ien of file 344.4
  1. ; RCDAT = array containing additional data to add to new entry
  1. ;
  1. N DIC,DLAYGO,X,Y,DO,DD,RCY,DINUM
  1. S RCY=0,DIC("DR")=""
  1. S DIC(0)="L",DLAYGO=344.49,(DINUM,X)=RCERA,DIC="^RCY(344.49,"
  1. I $G(RCDAT("CHECK#"))'="" S DIC("DR")=".04////"_RCDAT("CHECK#")_";"
  1. I $G(RCDAT("CHECKDT"))'="" S DIC("DR")=DIC("DR")_".05////"_RCDAT("CHECKDT")_";"
  1. I $G(RCDAT("BANK"))'="" S DIC("DR")=DIC("DR")_".06////"_RCDAT("BANK")_";"
  1. K DD,DO D FILE^DICN K DIC
  1. I Y>0 S RCY=+Y
  1. Q RCY
  1. ;
  1. HDR ; Creates header lines for the selected ERA display
  1. ; PRCA*4.5*349 - Reorganized NEW list & added XX temp. variable
  1. N I,RCARC,RCEEOBPU,RCSORTBY,RC,RC4,RC5,X,XX,Z ; PRCA*4.5*326 - RCARC added
  1. S RCSORTBY=$G(^TMP($J,"RC_SORTPARM")) ; PRCA*4.5*349 - Moved to top of subroutine
  1. S RCEEOBPU=$G(^TMP($J,"RC_EEOBPOST")) ; PRCA*4.5*349 - Moved to top of subroutine
  1. F I=1:1:6 S VALMHDR(I)="" ; PRCA*4.5*349 - Add a line to the header
  1. I '$G(RCSCR) S VALMQUIT=1 Q
  1. S RC=$G(^RCY(344.4,+RCSCR,0)),RC5=$G(^RCY(344.4,+RCSCR,5))
  1. S RC4=$G(^RCY(344.4,+RCSCR,4)) ;prca*4.5*298
  1. ; PRCA*4.5*349 - Begin Modified Code Block - Reorder header information
  1. S VALMHDR(1)="ERA Entry #: "_$P(RC,U)
  1. S $E(VALMHDR(1),43)="Total Amount Paid: "_$J(+$P(RC,U,5),"",2)
  1. S XX=$S(RCSORTBY="F":"ZERO-PAYMENTS FIRST",RCSORTBY="L":"ZERO-PAYMENTS LAST",1:"NO SORT ORDER")
  1. S VALMHDR(2)="Payment Order: "_XX
  1. S XX=$S(RCEEOBPU="P":"POSTED EEOBs ONLY",RCEEOBPU="U":"UNPOSTED EEOBs ONLY",1:"ALL EEOBS")
  1. S $E(VALMHDR(2),39)="Disp Auto-Posted ERAs: "_XX
  1. ; PRCA*4.5*349 - End Modified Code Block
  1. S Z=+$O(^RCY(344.31,"AERA",+RCSCR,0))
  1. I Z S VALMHDR(3)="EFT #/TRACE #: "_$$GET1^DIQ(344.31,Z_",",.01,"E")_"/"_$E($P(RC,U,2),1,40) ; PRCA*4.5*326
  1. I 'Z,$P(RC5,U,2)'="" S VALMHDR(3)="PAPER CHECK #: "_$P(RC5,U,2)
  1. S VALMHDR(4)=$P(RC,U,6)_"/"_$P(RC,U,3) ; PRCA*4.5*349 - Give all of fourth line to payer name/id
  1. ; prca*4.5*298 per patch requirements, keep code related to creating/maintaining
  1. ; batches but just remove from execution.
  1. ;I $G(^TMP("RCBATCH_SELECTED",$J)) D
  1. ;. N Z,Z0
  1. ;. S Z=+$G(^TMP("RCBATCH_SELECTED",$J)),Z0=$G(^RCY(344.49,RCSCR,3,Z,0))
  1. ;. S RCT=RCT+1,VALMHDR(RCT)="BATCH: "_Z_" "_$P(Z0,U,2)_" "_$$EXTERNAL^DILFD(344.493,.03,"",$P(Z0,U,3))
  1. I $G(RCSCR("NOEDIT")) D
  1. . S VALMHDR(5)="*** RECEIPT(S) ALREADY CREATED *** ("_$$RECEIPTS(RCSCR)_")" ; PRCA*4.5*349 - Shift down a line
  1. I $P(RC4,U,2)]"" D ;AUTO-POST STATUS (344.4, 4.02); if not null, then the selected ERA is designated for auto-post
  1. . ; Setting the Auto-Post info in the header
  1. . N AUTOPSTS
  1. . S AUTOPSTS="Auto-Post Status: "_$S($P(RC4,U,2)=0:"Unposted",$P(RC4,U,2)=1:"Partial",1:"Complete")
  1. . S AUTOPSTS=AUTOPSTS_" Auto-Post Date: "_$S($P(RC4,U,2)>0:$$FMTE^XLFDT($P(RC4,U)),1:"") ; PRCA*4.5*318
  1. . S VALMHDR(6)=AUTOPSTS ; PRCA*4.5*349 - Shift down a line
  1. ; BEGIN PRCA*4,.5*326
  1. ; Check for auto-decrease CARCs if this is a denial ERA
  1. I $$GET1^DIQ(344.4,+RCSCR,.15)="NON" D
  1. .N RCARC
  1. .S RCARC=$$WLH^RCDPEWLZ(+RCSCR)
  1. .S:RCARC]"" VALMHDR(5)=RCARC ; PRCA*4.5*349 - Shift down a line
  1. ; ENd PRCA*4,.5*326
  1. ; Displaying Current View (PRCA*4.5*298)
  1. ; PRCA*4.5*349 - Moved to top of routine and restructured
  1. Q
  1. ;
  1. FNL ; -- Clean up list
  1. K ^TMP("RCDPE-EOB_WLDX",$J),^TMP("RCDPE-EOB_WL",$J),^TMP($J,"RC_SORTPARM"),^TMP($J,"RC_BILL")
  1. D CLEAN^VALM10,CLEAR^VALM1
  1. K RCFASTXT
  1. Q
  1. ;
  1. SEL(RCDA) ; Select entry from worklist scratch pad screen
  1. ; RCDA = array returned if selections made
  1. ; RCDA(n)=ien of entry(s) in file 344.41
  1. ; where n = the line # selected
  1. K RCDA
  1. N VALMY
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RCDA(RCDA)=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCDA)),U,2,5)
  1. Q
  1. ;
  1. NOEDIT ; Display no edit allowed if receipt exists
  1. N DIR,X,Y
  1. S DIR(0)="EA",DIR("A",1)="This action is NOT available since the ERA already has a receipt."
  1. S DIR("A")="PRESS RETURN TO CONTINUE "
  1. W ! D ^DIR K DIR W !
  1. Q
  1. ;
  1. NOBATCH ; Display action not allowed if working at batch level not the ERA level
  1. N DIR,X,Y
  1. S DIR(0)="EA",DIR("A",1)="This action is NOT valid when in a batch within the ERA."
  1. S DIR("A")="PRESS RETURN TO CONTINUE "
  1. W ! D ^DIR K DIR W !
  1. Q
  1. ;
  1. RECEIPTS(RCSCR) ; get list of receipts for the ERA
  1. ; Input: RCSCR: ERA File (#344.4) IEN
  1. ; Output: "" - No Receipt / REC# - One Receipt / REC#A-REC#Z - Range of Receipts
  1. N X,RECEIPT,CTR,RC0
  1. K ARRAY,STR
  1. S X=0,CTR=1,(STR,RECEIPT)=""
  1. F S X=$O(^RCY(344.4,RCSCR,1,"RECEIPT",X)) Q:'X D
  1. . S:X RECEIPT=$P($G(^RCY(344,X,0)),U) ; get external form of receipt
  1. . I RECEIPT]"" S ARRAY(RECEIPT)=""
  1. ; array of receipts does not exist so this could be a non auto-posted ERA; so only 1 receipt will be assigned; retrieve at 344.4, .08
  1. I '$D(ARRAY),$$GET1^DIQ(344.4,RCSCR,.08)'="" S ARRAY($$GET1^DIQ(344.4,RCSCR,.08))=""
  1. ;
  1. I $O(ARRAY($O(ARRAY(""))))'="" D
  1. . S STR=$O(ARRAY(""))_"-"_$O(ARRAY(""),-1)
  1. E D
  1. . S STR=$O(ARRAY(""))
  1. Q STR