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