RCDPRPL3 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
;;4.5;Accounts Receivable;**114,148,153,173,301,326,367,371,409**;Mar 20, 1995;Build 17
;;Per VA Directive 6402, this routine should not be modified.
Q
;
; routine contains the entry points for receipt management
;
;
EDITREC ; option: edit the receipt, deposit #
N RCPAYTYP ;PRCA*4.5*409 - Added line
D FULL^VALM1
S VALMBCK="R"
S RCPAYTYP=$P(^RCY(344,RCRECTDA,0),"^",4) ;PRCA*4.5*409 - AR Event Type IEN
;
; PRCA*4.5*409 Added if - Prevent editing of Receipts with payment types of OGC-EFT
I RCPAYTYP=18 D Q
. N NEWEFT,OLDEFT
. I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
. S OLDEFT=$P($G(^RCY(344,RCRECTDA,0)),U,17)
. S NEWEFT=$$ASK17^RCDPUREC(RCRECTDA)
. I NEWEFT,NEWEFT'=OLDEFT D EDITREC2^RCDPUREC(RCRECTDA,OLDEFT,NEWEFT)
. D PAUSE
. L -^RCY(344,RCRECTDA)
. D HDR^RCDPRPLM
;
; PRCA*4.5*409 Added if - Prevent editing of Receipts with payment types of OGC-CHK
I RCPAYTYP=19 D Q
. W *7,!,"Receipts with a Payment Type of OGC-CHK cannot be edited"
. D PAUSE
;
I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
;
W !
D EDITREC^RCDPUREC(RCRECTDA)
L -^RCY(344,RCRECTDA)
;
; rebuild the header
D HDR^RCDPRPLM
Q
;
PAUSE() ; Pause at end of each page for user input
; PRCA*4.5*409 Added function
; Input: None
; Returns: None
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR("A")="Press return to continue"
S DIR(0)="E"
D ^DIR
Q Y
;
PROCESS ; option: process receipt
N CRTR,RC,RCAMT,RCHMP,RCEFT,RCEFT1,RCERA,RCHAC,RCOK,RCQUIT,X,XX,YY,Z ;PRCA*4.5*409 Added XX,YY
D FULL^VALM1
S VALMBCK="R"
;
S RC=$S('$P($G(^RCY(344,RCRECTDA,0)),U,6)&$$LBEVENT^RCDPEU():1,1:0),CRTR=$P("cash^transfer",U,RC+1)
W !!,"This option will process the payments for the receipt updating the AR"
W !,"Package and generate the "_CRTR_" receipt document to FMS. Any decrease"
W !,"adjustments entered via the EDI Lockbox Worklist will also be generated."
W !,"Once a receipt has been processed, the receipt status will change to closed"
W !,"and no further processing of the receipt can occur. If the FMS "_CRTR
W !," receipt document rejects, you can use this same option to reprocess the"
W !,"receipt.",!
;
S RCEFT=+$P($G(^RCY(344,RCRECTDA,0)),U,17),RCERA=$P($G(^(0)),U,18),RCHAC=0
S RCAMT=+$$PAYTOTAL^RCDPURED(RCRECTDA)
;
S RCQUIT=0
I RCERA,'RCEFT D Q:RCQUIT
. I +$P($G(^RCY(344.4,+RCERA,0)),U,5)'=RCAMT D S RCQUIT=1 Q
. . W !,"This receipt cannot be processed because the total amount of the associated"
. . W !," ERA ("_$J(+$P($G(^RCY(344.4,+RCERA,0)),U,5),"",2)_") does not equal the total amount on the receipt ("_$J(RCAMT,"",2)_")"
. . S VALMSG="Receipt total not = ERA total - Receipt NOT processed"
. . D RET^RCDPEWL2
;
I RCEFT D Q:'RCOK
. N RCOK1
. S RCOK=0,RCEFT1=+$G(^RCY(344.3,+RCEFT,0)),RCHAC=($E($P($G(^RCY(344.3,RCEFT1,0)),U,6),1,3)="HAC")
. N Z,DIR,DIE,DA,DR
. I $P($G(^RCY(344.3,+RCEFT1,0)),U,10) D Q
. . W !,"This receipt cannot be processed until EDI Lockbox checksum exception is"
. . W !," cleared on the EFT transmission"
. . S VALMSG="EDI LOCKBOX exception still exists - Receipt NOT processed"
. . D RET^RCDPEWL2
. ;
. I +$P($G(^RCY(344.31,+RCEFT,0)),U,7)'=RCAMT D Q
. . W !,"This receipt cannot be processed - the receipt total does not match the"
. . W !," EFT total for this EDI Lockbox receipt"
. . S VALMSG="EDI LOCKBOX total of receipt not = EFT - Receipt NOT processed"
. . D RET^RCDPEWL2
. ;
. ; Check that EFT funds were posted
. S RCOK1=1
. I $P($G(^RCY(344.3,+$G(^RCY(344.31,+RCEFT,0)),0)),U,8),$P($G(^RCY(344.31,+RCEFT,0)),U,7) D Q:'RCOK1
. . N RCRECTDA,RCDEPDA
. . S RCDEPDA=+$P($G(^RCY(344.3,+$G(^RCY(344.31,+RCEFT,0)),0)),U,3)
. . S RCRECTDA=+$O(^RCY(344,"AD",+RCDEPDA,0)) ; Get deposit and its receipt
. . I RCRECTDA S Z=$P($$FMSSTAT^RCDPUREC(RCRECTDA),U,2) Q:$E(Z)="A" Q:$E(Z)="O" ; EFT Accepted by FMS or ON-LINE ENTRY - PRCA*4.5*326
. . W !,"This receipt cannot be processed yet - the EFT's deposit has not been"
. . W !," successfully sent to FMS. Status currently is "_Z
. . S VALMSG="EDI LOCKBOX EFT not yet posted",RCOK1=0
. . D RET^RCDPEWL2
. S RCOK=1
;
; PRCA*4.5*367 - If CHAMPVA receipt, check against receipt total field
S RCHMP=$$ISCHMPVA^RCDPUREC(+$P($G(^RCY(344,RCRECTDA,0)),U,4))
I RCHMP D Q:RCQUIT
. N I,RCTOT,TXTOT
. S RCTOT=+$P($G(^RCY(344,RCRECTDA,0)),U,22),TXTOT=0
. S I=0 F S I=$O(^RCY(344,RCRECTDA,1,I)) Q:'+I D
. . S TXTOT=TXTOT+$P(^RCY(344,RCRECTDA,1,I,0),U,4)
. I RCTOT'=TXTOT D
. . S RCQUIT=1
. . W !,"This receipt cannot be processed because the RECEIPT TOTAL does not equal"
. . W !," does not equal the total amount on the receipt ("_$J(RCAMT,"",2)_")"
. . S VALMSG="Receipt total not match RECEIPT TOTAL"
. . D RET^RCDPEWL2
;
I +$P($G(^RCY(344,RCRECTDA,0)),U,6),+$P(^(0),U,17) D Q:'RCOK
. S RCOK=0
. S DIR("A",1)="A DEPOSIT CANNOT BE ASSOCIATED WITH AN EDI LOCKBOX EFT DETAIL RECEIPT"
. S DIR(0)="YA",DIR("A")="DO YOU WANT TO DELETE THIS RECEIPT'S DEPOSIT REFERENCE NOW?: "
. S DIR("B")="NO"
. W ! D ^DIR K DIR
. I Y=1 S DIE="^RCY(344,",DR=".06///@",DA=RCRECTDA D ^DIE S RCOK=1 Q
. S VALMSG="EDI LBOX ERA receipt cannot have a deposit - Receipt NOT processed"
;
N RCDEPTDA,RCDPDATA,RCDPFLAG,RCDPFHLP,RCTRDA,RCSCR,STATUS,RCADJ
;
; Lock receipt
I '$$LOCKREC^RCDPRPLU(RCRECTDA) S VALMSG="Receipt NOT Processed." Q
;
; Apply decrease adjustments from worklist entry
S RCSCR=+$O(^RCY(344.4,"ARCT",RCRECTDA,0)),RCSCR=$S($D(^RCY(344.49,+RCSCR,0)):RCSCR,1:0)
S RCADJ=$$ERAWL^RCDPRPL4(RCSCR)
I RCADJ=2 D UNLOCK Q
I RCADJ<0 D Q
. W !,"The bill balance for the bills listed above must be manually increased to"
. W !,"accommodate the automatic ERA Worklist dec adjustment amounts and to allow"
. W !,"the ERA receipt to be balanced - Receipt NOT processed."
. D UNLOCK
;
; Warning no transactions
I '$O(^RCY(344,RCRECTDA,1,0)) D
. W !,"WARNING, no transactions are on the receipt. Processing will only change"
. W !,"the status of the receipt to closed."
;
D DIQ344^RCDPRPLM(RCRECTDA,".04;.06;.08;.17;.18;200;") ;PRCA*4.5*409 Added .04;
;
; Code sheet already sent once, this is a retransmission, check it
I RCDPDATA(344,RCRECTDA,200,"E")'="" D
. S STATUS=$$STATUS^GECSSGET(RCDPDATA(344,RCRECTDA,200,"E"))
. W !,"This receipt has been previously processed to FMS in the cash receipt"
. W !,"document ",$TR(RCDPDATA(344,RCRECTDA,200,"E")," ")
. W ". The current status for this document in the"
. W !,"Generic Code Sheet Stack file is ",STATUS,"."
. ;
. ; Okay to continue if status is Error, Rejected, or not defined (-1)
. I $E(STATUS)="E"!($E(STATUS)="R")!(STATUS=-1) Q
. ;
. ; Okay to continue if document has not been transmitted
. I $E(STATUS)="Q"!($E(STATUS)="M") Q
. ;
. ; Okay to continue if document is transmitted for 2 days
. I $E(STATUS)="T",$$FMDIFF^XLFDT(DT,RCDPDATA(344,RCRECTDA,.08,"I"))>1 Q
. ;
. ; Do not allow reprocessing
. S RCDPFLAG=1
. I $E(STATUS)="A" W !!,"You cannot reprocess and retransmit an ACCEPTED document."
. I $E(STATUS)="T" D
. . W !!,"You cannot reprocess and retransmit a document which has previously been"
. . W !,"transmitted and is waiting on confirmation (less than 2 days since",!,"processing)."
I $G(RCDPFLAG) D UNLOCK Q
;
; Check payments to verify it doesn't exceed bill amt
W !!,"Checking payment amounts versus billed amounts ..."
S RCTRDA=0 F S RCTRDA=$O(^RCY(344,RCRECTDA,1,RCTRDA)) Q:'RCTRDA D
. S X=$$CHECKPAY(RCRECTDA,RCTRDA)
. I 'X Q
. ;
. ; Exceeds billed amt
. S RCDPFLAG=1
. ;
. ; Check for >1 pending payment for this transaction
. I +$P(X,"^",3)'=$P(^RCY(344,RCRECTDA,1,RCTRDA,0),"^",4) S RCDPFLAG=2
. W !," " I RCDPFLAG=2 W "*" S RCDPFHLP=1
. W "WARNING: Trans# ",RCTRDA,". Pending Payments $ ",$J($P(X,"^",3),0,2)
. W " exceed billed amount $ ",$J($P(X,"^",2),0,2)
I $G(RCDPFLAG) D Q
. I $G(RCDPFHLP) W !,"NOTE: * Indicates more than one pending payment entered against this bill."
. W !,"Adjust payments listed above before processing."
. D UNLOCK
;
W " payments okay."
;
S RCDEPTDA=RCDPDATA(344,RCRECTDA,.06,"I")
I RCDEPTDA I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) D UNLOCK Q ; Lock deposit ticket
;
; Check for critical fields, deposit ticket, date of deposit
; No deposit ticket is OK for ERA not related to an EFT or for HAC ERA
; PRCA*4.5*367 - Do not create deposit ticket for CHAMPVA receipts
; PRCA*4.5*371 - EDI LOCKBOX type Receipts have an EFT and don't need a deposit #
S XX=$S('$G(RCDPDATA(344,RCRECTDA,.18,"I")):1,$$EDILB^RCDPEU(RCRECTDA)=2:0,1:'$$HAC^RCDPURE1(RCRECTDA))
I 'RCEFT,'RCHMP,'RCDEPTDA,XX D
. W !!,"WARNING, Deposit Ticket is missing. If you continue with processing,"
. W !,"the AR accounts will be updated and a cash receipt (CR) document will"
. W !,"NOT be sent to FMS. You have the option to add the Deposit Ticket now."
. D EDITREC^RCDPUREC(RCRECTDA,".06;")
. S (RCDEPTDA,RCDPDATA(344,RCRECTDA,.06,"I"))=$P(^RCY(344,RCRECTDA,0),"^",6)
;
;PRCA*4.5*409 Begin Added lines
S XX=+$G(RCDPDATA(344,RCRECTDA,.04,"I")) ; AR Event Type (341.1)
S YY=$$TXLINE(RCRECTDA) ; 1 if non-cancelled Transaction Lines
;
;PRCA*4.5*409 Check Receipts and OGC-CHK Receipts must have a deposit in order to be processed
I 'RCDEPTDA,YY,((XX=4)!(XX=19)) D Q
. W !!,"CHECK/MO PAYMENT and OGC-CHK Receipts with at least one non-cancelled Payment"
. W !,"MUST have a deposit in order to be processed."
. D UNLOCK
;
;PRCA*4.5*409 End Added lines
;
; Deposit ticket added
I RCDEPTDA D
. D EDITDEP^RCDPUDEP(RCDEPTDA,1)
. D DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
. I RCDPDATA(344.1,RCDEPTDA,.03,"I") Q
. W !!,"No DEPOSIT DATE, you can edit the deposit data now."
. D EDITDEP^RCDPUDEP(RCDEPTDA,1)
. D DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
. I RCDPDATA(344.1,RCDEPTDA,.03,"I") Q
. W !!,"Still No DEPOSIT DATE, use the Edit Deposit option under Deposit Processing."
. S RCDPFLAG=1
I $G(RCDPFLAG) D UNLOCK Q
;
W !
I $$ASKPROC'=1 D Q
. I $G(RCADJ)>0 D
. . W !!,*7,"WARNING - EDI Lbox Worklist auto dec adjustments have already been made for"
. . W !,"this receipt!!!"
. D UNLOCK
;
; Process receipt, pass 1 to show messages
D PROCESS^RCDPURE1(RCRECTDA,1) K CSRECPT
D UNLOCK
D INIT^RCDPRPLM
D HDR^RCDPRPLM
I $P(^RCY(344,RCRECTDA,0),"^",8) S VALMSG="Receipt PROCESSED."
Q
;
UNLOCK ; Unlock/pause
L -^RCY(344,RCRECTDA)
I $G(RCDEPTDA) L -^RCY(344.1,RCDEPTDA)
W !!,"Press RETURN to continue: " R X:DTIME
S VALMSG="Receipt NOT Processed."
D HDR^RCDPRPLM
Q
;
;PRCA*4.5*409 Added Method
TXLINE(RCRECTDA) ; Check if the receipt has at least one transaction that is not cancelled
; Input: RCRECTDA - IEN of the Receipt (File #344)
; Returns: 1 if at least one non-cancelled transaction line exists, 0 otherwise
N FOUND,TXLINE
S FOUND=0,TXLINE=0
F D Q:+TXLINE=0 Q:FOUND
. S TXLINE=$O(^RCY(344,RCRECTDA,1,TXLINE))
. Q:+TXLINE=0
. S:'$D(^RCY(344,RCRECTDA,1,TXLINE,1)) FOUND=1
Q FOUND
;
CHECKPAY(RCRECTDA,RCTRDA) ; called to check amt pd against amt of bill
N PAYDATA,PENDING,X
; receipt already processed
I $P($G(^RCY(344,RCRECTDA,0)),"^",7) Q 0
S PAYDATA=$G(^RCY(344,RCRECTDA,1,RCTRDA,0))
; payment is 0
I '$P(PAYDATA,"^",4) Q 0
; payment processed
I $P(PAYDATA,"^",5) Q 0
; not a bill
I $P(PAYDATA,"^",3)'["PRCA(430," Q 0
; first party bill (do not check dollars)
I $P($G(^RCD(340,+$P($G(^PRCA(430,+$P(PAYDATA,"^",3),0)),"^",9),0)),"^")["DPT(" Q 0
; TCSP bill, no payments allowed prca*4.5*301 BB
I $D(^PRCA(430,"TCSP",+$P(PAYDATA,"^",3))) Q 0
; bill not activated or open
S X=$P($G(^PRCA(430,+$P(PAYDATA,"^",3),0)),"^",8)
I X'=42,X'=16 Q "1^0"
; calculate dollars on receivable
S X=$G(^PRCA(430,+$P(PAYDATA,"^",3),7)),X=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
; get pending payments
; use pending since there may be more than one payment
; to the same bill on the receipt
S PENDING=$$PENDPAY^RCDPURET($P(PAYDATA,"^",3))
K ^TMP($J,"RCDPUREC","PP") ;set by pending payment call
; pending payments is not > billed
I PENDING'>X Q 0
; greater, return billed amt ^ pending payment amt
Q "1^"_X_"^"_PENDING
;
;
ASKPROC() ; ask if its okay to process the receipt
; 1 is yes, otherwise no
N DIR,DIQ2,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Are you sure you want to PROCESS this receipt"
D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRPL3 12703 printed Apr 09, 2024@20:49:08 Page 2
RCDPRPL3 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,148,153,173,301,326,367,371,409**;Mar 20, 1995;Build 17
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ; routine contains the entry points for receipt management
+6 ;
+7 ;
EDITREC ; option: edit the receipt, deposit #
+1 ;PRCA*4.5*409 - Added line
NEW RCPAYTYP
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 ;PRCA*4.5*409 - AR Event Type IEN
SET RCPAYTYP=$PIECE(^RCY(344,RCRECTDA,0),"^",4)
+5 ;
+6 ; PRCA*4.5*409 Added if - Prevent editing of Receipts with payment types of OGC-EFT
+7 IF RCPAYTYP=18
Begin DoDot:1
+8 NEW NEWEFT,OLDEFT
+9 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
QUIT
+10 SET OLDEFT=$PIECE($GET(^RCY(344,RCRECTDA,0)),U,17)
+11 SET NEWEFT=$$ASK17^RCDPUREC(RCRECTDA)
+12 IF NEWEFT
IF NEWEFT'=OLDEFT
DO EDITREC2^RCDPUREC(RCRECTDA,OLDEFT,NEWEFT)
+13 DO PAUSE
+14 LOCK -^RCY(344,RCRECTDA)
+15 DO HDR^RCDPRPLM
End DoDot:1
QUIT
+16 ;
+17 ; PRCA*4.5*409 Added if - Prevent editing of Receipts with payment types of OGC-CHK
+18 IF RCPAYTYP=19
Begin DoDot:1
+19 WRITE *7,!,"Receipts with a Payment Type of OGC-CHK cannot be edited"
+20 DO PAUSE
End DoDot:1
QUIT
+21 ;
+22 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
QUIT
+23 ;
+24 WRITE !
+25 DO EDITREC^RCDPUREC(RCRECTDA)
+26 LOCK -^RCY(344,RCRECTDA)
+27 ;
+28 ; rebuild the header
+29 DO HDR^RCDPRPLM
+30 QUIT
+31 ;
PAUSE() ; Pause at end of each page for user input
+1 ; PRCA*4.5*409 Added function
+2 ; Input: None
+3 ; Returns: None
+4 ;
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DIR("A")="Press return to continue"
+7 SET DIR(0)="E"
+8 DO ^DIR
+9 QUIT Y
+10 ;
PROCESS ; option: process receipt
+1 ;PRCA*4.5*409 Added XX,YY
NEW CRTR,RC,RCAMT,RCHMP,RCEFT,RCEFT1,RCERA,RCHAC,RCOK,RCQUIT,X,XX,YY,Z
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 ;
+5 SET RC=$SELECT('$PIECE($GET(^RCY(344,RCRECTDA,0)),U,6)&$$LBEVENT^RCDPEU():1,1:0)
SET CRTR=$PIECE("cash^transfer",U,RC+1)
+6 WRITE !!,"This option will process the payments for the receipt updating the AR"
+7 WRITE !,"Package and generate the "_CRTR_" receipt document to FMS. Any decrease"
+8 WRITE !,"adjustments entered via the EDI Lockbox Worklist will also be generated."
+9 WRITE !,"Once a receipt has been processed, the receipt status will change to closed"
+10 WRITE !,"and no further processing of the receipt can occur. If the FMS "_CRTR
+11 WRITE !," receipt document rejects, you can use this same option to reprocess the"
+12 WRITE !,"receipt.",!
+13 ;
+14 SET RCEFT=+$PIECE($GET(^RCY(344,RCRECTDA,0)),U,17)
SET RCERA=$PIECE($GET(^(0)),U,18)
SET RCHAC=0
+15 SET RCAMT=+$$PAYTOTAL^RCDPURED(RCRECTDA)
+16 ;
+17 SET RCQUIT=0
+18 IF RCERA
IF 'RCEFT
Begin DoDot:1
+19 IF +$PIECE($GET(^RCY(344.4,+RCERA,0)),U,5)'=RCAMT
Begin DoDot:2
+20 WRITE !,"This receipt cannot be processed because the total amount of the associated"
+21 WRITE !," ERA ("_$JUSTIFY(+$PIECE($GET(^RCY(344.4,+RCERA,0)),U,5),"",2)_") does not equal the total amount on the receipt ("_$JUSTIFY(RCAMT,"",2)_")"
+22 SET VALMSG="Receipt total not = ERA total - Receipt NOT processed"
+23 DO RET^RCDPEWL2
End DoDot:2
SET RCQUIT=1
QUIT
End DoDot:1
if RCQUIT
QUIT
+24 ;
+25 IF RCEFT
Begin DoDot:1
+26 NEW RCOK1
+27 SET RCOK=0
SET RCEFT1=+$GET(^RCY(344.3,+RCEFT,0))
SET RCHAC=($EXTRACT($PIECE($GET(^RCY(344.3,RCEFT1,0)),U,6),1,3)="HAC")
+28 NEW Z,DIR,DIE,DA,DR
+29 IF $PIECE($GET(^RCY(344.3,+RCEFT1,0)),U,10)
Begin DoDot:2
+30 WRITE !,"This receipt cannot be processed until EDI Lockbox checksum exception is"
+31 WRITE !," cleared on the EFT transmission"
+32 SET VALMSG="EDI LOCKBOX exception still exists - Receipt NOT processed"
+33 DO RET^RCDPEWL2
End DoDot:2
QUIT
+34 ;
+35 IF +$PIECE($GET(^RCY(344.31,+RCEFT,0)),U,7)'=RCAMT
Begin DoDot:2
+36 WRITE !,"This receipt cannot be processed - the receipt total does not match the"
+37 WRITE !," EFT total for this EDI Lockbox receipt"
+38 SET VALMSG="EDI LOCKBOX total of receipt not = EFT - Receipt NOT processed"
+39 DO RET^RCDPEWL2
End DoDot:2
QUIT
+40 ;
+41 ; Check that EFT funds were posted
+42 SET RCOK1=1
+43 IF $PIECE($GET(^RCY(344.3,+$GET(^RCY(344.31,+RCEFT,0)),0)),U,8)
IF $PIECE($GET(^RCY(344.31,+RCEFT,0)),U,7)
Begin DoDot:2
+44 NEW RCRECTDA,RCDEPDA
+45 SET RCDEPDA=+$PIECE($GET(^RCY(344.3,+$GET(^RCY(344.31,+RCEFT,0)),0)),U,3)
+46 ; Get deposit and its receipt
SET RCRECTDA=+$ORDER(^RCY(344,"AD",+RCDEPDA,0))
+47 ; EFT Accepted by FMS or ON-LINE ENTRY - PRCA*4.5*326
IF RCRECTDA
SET Z=$PIECE($$FMSSTAT^RCDPUREC(RCRECTDA),U,2)
if $EXTRACT(Z)="A"
QUIT
if $EXTRACT(Z)="O"
QUIT
+48 WRITE !,"This receipt cannot be processed yet - the EFT's deposit has not been"
+49 WRITE !," successfully sent to FMS. Status currently is "_Z
+50 SET VALMSG="EDI LOCKBOX EFT not yet posted"
SET RCOK1=0
+51 DO RET^RCDPEWL2
End DoDot:2
if 'RCOK1
QUIT
+52 SET RCOK=1
End DoDot:1
if 'RCOK
QUIT
+53 ;
+54 ; PRCA*4.5*367 - If CHAMPVA receipt, check against receipt total field
+55 SET RCHMP=$$ISCHMPVA^RCDPUREC(+$PIECE($GET(^RCY(344,RCRECTDA,0)),U,4))
+56 IF RCHMP
Begin DoDot:1
+57 NEW I,RCTOT,TXTOT
+58 SET RCTOT=+$PIECE($GET(^RCY(344,RCRECTDA,0)),U,22)
SET TXTOT=0
+59 SET I=0
FOR
SET I=$ORDER(^RCY(344,RCRECTDA,1,I))
if '+I
QUIT
Begin DoDot:2
+60 SET TXTOT=TXTOT+$PIECE(^RCY(344,RCRECTDA,1,I,0),U,4)
End DoDot:2
+61 IF RCTOT'=TXTOT
Begin DoDot:2
+62 SET RCQUIT=1
+63 WRITE !,"This receipt cannot be processed because the RECEIPT TOTAL does not equal"
+64 WRITE !," does not equal the total amount on the receipt ("_$JUSTIFY(RCAMT,"",2)_")"
+65 SET VALMSG="Receipt total not match RECEIPT TOTAL"
+66 DO RET^RCDPEWL2
End DoDot:2
End DoDot:1
if RCQUIT
QUIT
+67 ;
+68 IF +$PIECE($GET(^RCY(344,RCRECTDA,0)),U,6)
IF +$PIECE(^(0),U,17)
Begin DoDot:1
+69 SET RCOK=0
+70 SET DIR("A",1)="A DEPOSIT CANNOT BE ASSOCIATED WITH AN EDI LOCKBOX EFT DETAIL RECEIPT"
+71 SET DIR(0)="YA"
SET DIR("A")="DO YOU WANT TO DELETE THIS RECEIPT'S DEPOSIT REFERENCE NOW?: "
+72 SET DIR("B")="NO"
+73 WRITE !
DO ^DIR
KILL DIR
+74 IF Y=1
SET DIE="^RCY(344,"
SET DR=".06///@"
SET DA=RCRECTDA
DO ^DIE
SET RCOK=1
QUIT
+75 SET VALMSG="EDI LBOX ERA receipt cannot have a deposit - Receipt NOT processed"
End DoDot:1
if 'RCOK
QUIT
+76 ;
+77 NEW RCDEPTDA,RCDPDATA,RCDPFLAG,RCDPFHLP,RCTRDA,RCSCR,STATUS,RCADJ
+78 ;
+79 ; Lock receipt
+80 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
SET VALMSG="Receipt NOT Processed."
QUIT
+81 ;
+82 ; Apply decrease adjustments from worklist entry
+83 SET RCSCR=+$ORDER(^RCY(344.4,"ARCT",RCRECTDA,0))
SET RCSCR=$SELECT($DATA(^RCY(344.49,+RCSCR,0)):RCSCR,1:0)
+84 SET RCADJ=$$ERAWL^RCDPRPL4(RCSCR)
+85 IF RCADJ=2
DO UNLOCK
QUIT
+86 IF RCADJ<0
Begin DoDot:1
+87 WRITE !,"The bill balance for the bills listed above must be manually increased to"
+88 WRITE !,"accommodate the automatic ERA Worklist dec adjustment amounts and to allow"
+89 WRITE !,"the ERA receipt to be balanced - Receipt NOT processed."
+90 DO UNLOCK
End DoDot:1
QUIT
+91 ;
+92 ; Warning no transactions
+93 IF '$ORDER(^RCY(344,RCRECTDA,1,0))
Begin DoDot:1
+94 WRITE !,"WARNING, no transactions are on the receipt. Processing will only change"
+95 WRITE !,"the status of the receipt to closed."
End DoDot:1
+96 ;
+97 ;PRCA*4.5*409 Added .04;
DO DIQ344^RCDPRPLM(RCRECTDA,".04;.06;.08;.17;.18;200;")
+98 ;
+99 ; Code sheet already sent once, this is a retransmission, check it
+100 IF RCDPDATA(344,RCRECTDA,200,"E")'=""
Begin DoDot:1
+101 SET STATUS=$$STATUS^GECSSGET(RCDPDATA(344,RCRECTDA,200,"E"))
+102 WRITE !,"This receipt has been previously processed to FMS in the cash receipt"
+103 WRITE !,"document ",$TRANSLATE(RCDPDATA(344,RCRECTDA,200,"E")," ")
+104 WRITE ". The current status for this document in the"
+105 WRITE !,"Generic Code Sheet Stack file is ",STATUS,"."
+106 ;
+107 ; Okay to continue if status is Error, Rejected, or not defined (-1)
+108 IF $EXTRACT(STATUS)="E"!($EXTRACT(STATUS)="R")!(STATUS=-1)
QUIT
+109 ;
+110 ; Okay to continue if document has not been transmitted
+111 IF $EXTRACT(STATUS)="Q"!($EXTRACT(STATUS)="M")
QUIT
+112 ;
+113 ; Okay to continue if document is transmitted for 2 days
+114 IF $EXTRACT(STATUS)="T"
IF $$FMDIFF^XLFDT(DT,RCDPDATA(344,RCRECTDA,.08,"I"))>1
QUIT
+115 ;
+116 ; Do not allow reprocessing
+117 SET RCDPFLAG=1
+118 IF $EXTRACT(STATUS)="A"
WRITE !!,"You cannot reprocess and retransmit an ACCEPTED document."
+119 IF $EXTRACT(STATUS)="T"
Begin DoDot:2
+120 WRITE !!,"You cannot reprocess and retransmit a document which has previously been"
+121 WRITE !,"transmitted and is waiting on confirmation (less than 2 days since",!,"processing)."
End DoDot:2
End DoDot:1
+122 IF $GET(RCDPFLAG)
DO UNLOCK
QUIT
+123 ;
+124 ; Check payments to verify it doesn't exceed bill amt
+125 WRITE !!,"Checking payment amounts versus billed amounts ..."
+126 SET RCTRDA=0
FOR
SET RCTRDA=$ORDER(^RCY(344,RCRECTDA,1,RCTRDA))
if 'RCTRDA
QUIT
Begin DoDot:1
+127 SET X=$$CHECKPAY(RCRECTDA,RCTRDA)
+128 IF 'X
QUIT
+129 ;
+130 ; Exceeds billed amt
+131 SET RCDPFLAG=1
+132 ;
+133 ; Check for >1 pending payment for this transaction
+134 IF +$PIECE(X,"^",3)'=$PIECE(^RCY(344,RCRECTDA,1,RCTRDA,0),"^",4)
SET RCDPFLAG=2
+135 WRITE !," "
IF RCDPFLAG=2
WRITE "*"
SET RCDPFHLP=1
+136 WRITE "WARNING: Trans# ",RCTRDA,". Pending Payments $ ",$JUSTIFY($PIECE(X,"^",3),0,2)
+137 WRITE " exceed billed amount $ ",$JUSTIFY($PIECE(X,"^",2),0,2)
End DoDot:1
+138 IF $GET(RCDPFLAG)
Begin DoDot:1
+139 IF $GET(RCDPFHLP)
WRITE !,"NOTE: * Indicates more than one pending payment entered against this bill."
+140 WRITE !,"Adjust payments listed above before processing."
+141 DO UNLOCK
End DoDot:1
QUIT
+142 ;
+143 WRITE " payments okay."
+144 ;
+145 SET RCDEPTDA=RCDPDATA(344,RCRECTDA,.06,"I")
+146 ; Lock deposit ticket
IF RCDEPTDA
IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
DO UNLOCK
QUIT
+147 ;
+148 ; Check for critical fields, deposit ticket, date of deposit
+149 ; No deposit ticket is OK for ERA not related to an EFT or for HAC ERA
+150 ; PRCA*4.5*367 - Do not create deposit ticket for CHAMPVA receipts
+151 ; PRCA*4.5*371 - EDI LOCKBOX type Receipts have an EFT and don't need a deposit #
+152 SET XX=$SELECT('$GET(RCDPDATA(344,RCRECTDA,.18,"I")):1,$$EDILB^RCDPEU(RCRECTDA)=2:0,1:'$$HAC^RCDPURE1(RCRECTDA))
+153 IF 'RCEFT
IF 'RCHMP
IF 'RCDEPTDA
IF XX
Begin DoDot:1
+154 WRITE !!,"WARNING, Deposit Ticket is missing. If you continue with processing,"
+155 WRITE !,"the AR accounts will be updated and a cash receipt (CR) document will"
+156 WRITE !,"NOT be sent to FMS. You have the option to add the Deposit Ticket now."
+157 DO EDITREC^RCDPUREC(RCRECTDA,".06;")
+158 SET (RCDEPTDA,RCDPDATA(344,RCRECTDA,.06,"I"))=$PIECE(^RCY(344,RCRECTDA,0),"^",6)
End DoDot:1
+159 ;
+160 ;PRCA*4.5*409 Begin Added lines
+161 ; AR Event Type (341.1)
SET XX=+$GET(RCDPDATA(344,RCRECTDA,.04,"I"))
+162 ; 1 if non-cancelled Transaction Lines
SET YY=$$TXLINE(RCRECTDA)
+163 ;
+164 ;PRCA*4.5*409 Check Receipts and OGC-CHK Receipts must have a deposit in order to be processed
+165 IF 'RCDEPTDA
IF YY
IF ((XX=4)!(XX=19))
Begin DoDot:1
+166 WRITE !!,"CHECK/MO PAYMENT and OGC-CHK Receipts with at least one non-cancelled Payment"
+167 WRITE !,"MUST have a deposit in order to be processed."
+168 DO UNLOCK
End DoDot:1
QUIT
+169 ;
+170 ;PRCA*4.5*409 End Added lines
+171 ;
+172 ; Deposit ticket added
+173 IF RCDEPTDA
Begin DoDot:1
+174 DO EDITDEP^RCDPUDEP(RCDEPTDA,1)
+175 DO DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
+176 IF RCDPDATA(344.1,RCDEPTDA,.03,"I")
QUIT
+177 WRITE !!,"No DEPOSIT DATE, you can edit the deposit data now."
+178 DO EDITDEP^RCDPUDEP(RCDEPTDA,1)
+179 DO DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
+180 IF RCDPDATA(344.1,RCDEPTDA,.03,"I")
QUIT
+181 WRITE !!,"Still No DEPOSIT DATE, use the Edit Deposit option under Deposit Processing."
+182 SET RCDPFLAG=1
End DoDot:1
+183 IF $GET(RCDPFLAG)
DO UNLOCK
QUIT
+184 ;
+185 WRITE !
+186 IF $$ASKPROC'=1
Begin DoDot:1
+187 IF $GET(RCADJ)>0
Begin DoDot:2
+188 WRITE !!,*7,"WARNING - EDI Lbox Worklist auto dec adjustments have already been made for"
+189 WRITE !,"this receipt!!!"
End DoDot:2
+190 DO UNLOCK
End DoDot:1
QUIT
+191 ;
+192 ; Process receipt, pass 1 to show messages
+193 DO PROCESS^RCDPURE1(RCRECTDA,1)
KILL CSRECPT
+194 DO UNLOCK
+195 DO INIT^RCDPRPLM
+196 DO HDR^RCDPRPLM
+197 IF $PIECE(^RCY(344,RCRECTDA,0),"^",8)
SET VALMSG="Receipt PROCESSED."
+198 QUIT
+199 ;
UNLOCK ; Unlock/pause
+1 LOCK -^RCY(344,RCRECTDA)
+2 IF $GET(RCDEPTDA)
LOCK -^RCY(344.1,RCDEPTDA)
+3 WRITE !!,"Press RETURN to continue: "
READ X:DTIME
+4 SET VALMSG="Receipt NOT Processed."
+5 DO HDR^RCDPRPLM
+6 QUIT
+7 ;
+8 ;PRCA*4.5*409 Added Method
TXLINE(RCRECTDA) ; Check if the receipt has at least one transaction that is not cancelled
+1 ; Input: RCRECTDA - IEN of the Receipt (File #344)
+2 ; Returns: 1 if at least one non-cancelled transaction line exists, 0 otherwise
+3 NEW FOUND,TXLINE
+4 SET FOUND=0
SET TXLINE=0
+5 FOR
Begin DoDot:1
+6 SET TXLINE=$ORDER(^RCY(344,RCRECTDA,1,TXLINE))
+7 if +TXLINE=0
QUIT
+8 if '$DATA(^RCY(344,RCRECTDA,1,TXLINE,1))
SET FOUND=1
End DoDot:1
if +TXLINE=0
QUIT
if FOUND
QUIT
+9 QUIT FOUND
+10 ;
CHECKPAY(RCRECTDA,RCTRDA) ; called to check amt pd against amt of bill
+1 NEW PAYDATA,PENDING,X
+2 ; receipt already processed
+3 IF $PIECE($GET(^RCY(344,RCRECTDA,0)),"^",7)
QUIT 0
+4 SET PAYDATA=$GET(^RCY(344,RCRECTDA,1,RCTRDA,0))
+5 ; payment is 0
+6 IF '$PIECE(PAYDATA,"^",4)
QUIT 0
+7 ; payment processed
+8 IF $PIECE(PAYDATA,"^",5)
QUIT 0
+9 ; not a bill
+10 IF $PIECE(PAYDATA,"^",3)'["PRCA(430,"
QUIT 0
+11 ; first party bill (do not check dollars)
+12 IF $PIECE($GET(^RCD(340,+$PIECE($GET(^PRCA(430,+$PIECE(PAYDATA,"^",3),0)),"^",9),0)),"^")["DPT("
QUIT 0
+13 ; TCSP bill, no payments allowed prca*4.5*301 BB
+14 IF $DATA(^PRCA(430,"TCSP",+$PIECE(PAYDATA,"^",3)))
QUIT 0
+15 ; bill not activated or open
+16 SET X=$PIECE($GET(^PRCA(430,+$PIECE(PAYDATA,"^",3),0)),"^",8)
+17 IF X'=42
IF X'=16
QUIT "1^0"
+18 ; calculate dollars on receivable
+19 SET X=$GET(^PRCA(430,+$PIECE(PAYDATA,"^",3),7))
SET X=$PIECE(X,"^")+$PIECE(X,"^",2)+$PIECE(X,"^",3)+$PIECE(X,"^",4)+$PIECE(X,"^",5)
+20 ; get pending payments
+21 ; use pending since there may be more than one payment
+22 ; to the same bill on the receipt
+23 SET PENDING=$$PENDPAY^RCDPURET($PIECE(PAYDATA,"^",3))
+24 ;set by pending payment call
KILL ^TMP($JOB,"RCDPUREC","PP")
+25 ; pending payments is not > billed
+26 IF PENDING'>X
QUIT 0
+27 ; greater, return billed amt ^ pending payment amt
+28 QUIT "1^"_X_"^"_PENDING
+29 ;
+30 ;
ASKPROC() ; ask if its okay to process the receipt
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="YO"
SET DIR("B")="NO"
+4 SET DIR("A")=" Are you sure you want to PROCESS this receipt"
+5 DO ^DIR
+6 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+7 QUIT Y
