RCDPRPL3 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
;;4.5;Accounts Receivable;**114,148,153,173,301,326**;Mar 20, 1995;Build 26
;;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 #
D FULL^VALM1
S VALMBCK="R"
;
I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
;
W !
D EDITREC^RCDPUREC(RCRECTDA)
L -^RCY(344,RCRECTDA)
;
; rebuild the header
D HDR^RCDPRPLM
Q
;
;
PROCESS ; option: process receipt
N RCNE,RCOK,RCEFT,RCEFT1,RCHAC,RC,RCERA,RCAMT,RCQUIT,CRTR,Z ;PRCA*4.5*326 added RCNE
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",!," 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",!," 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",!," 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),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" ; EFT Accepted by FMS
.. W !,"This receipt cannot be processed yet - the EFT's deposit has not been",!," successfully sent to FMS. Status currently is "_Z
.. S VALMSG="EDI LOCKBOX EFT not yet posted",RCOK1=0
.. D RET^RCDPEWL2
. S RCOK=1
;
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?: ",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",!,"accommodate the automatic ERA Worklist dec adjustment amounts and to allow",!,"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,".06;.08;.17;.18;200;")
; 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")," "),". 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" W !!,"You cannot reprocess and retransmit a document which has previously been",!,"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)," 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")
; lock deposit tckt
I RCDEPTDA I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) D UNLOCK Q
;
; 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
I 'RCDEPTDA,$S('$G(RCDPDATA(344,RCRECTDA,.18,"I")):1,$$EDILB^RCDPEU(RCRECTDA)=2:0,1:'$$HAC^RCDPURE1(RCRECTDA)) 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)
;
; 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 W !!,*7,"WARNING - EDI Lbox Worklist auto dec adjustments have already been made for",!,"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
;
;
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 9788 printed Jan 14, 2021@16:38:02 Page 2
RCDPRPL3 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,148,153,173,301,326**;Mar 20, 1995;Build 26
+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 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
QUIT
+5 ;
+6 WRITE !
+7 DO EDITREC^RCDPUREC(RCRECTDA)
+8 LOCK -^RCY(344,RCRECTDA)
+9 ;
+10 ; rebuild the header
+11 DO HDR^RCDPRPLM
+12 QUIT
+13 ;
+14 ;
PROCESS ; option: process receipt
+1 ;PRCA*4.5*326 added RCNE
NEW RCNE,RCOK,RCEFT,RCEFT1,RCHAC,RC,RCERA,RCAMT,RCQUIT,CRTR,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",!," ERA ("_$JUSTIFY(+$PIECE($GET(^RCY(344.4,+RCERA,0)),U,5),"",2)_") does not equal the total amount on the receipt ("_$JUSTIFY(RCAMT,"",2
)_")"
+21 SET VALMSG="Receipt total not = ERA total - Receipt NOT processed"
+22 DO RET^RCDPEWL2
End DoDot:2
SET RCQUIT=1
QUIT
End DoDot:1
if RCQUIT
QUIT
+23 ;
+24 IF RCEFT
Begin DoDot:1
+25 NEW RCOK1
+26 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")
+27 NEW Z,DIR,DIE,DA,DR
+28 IF $PIECE($GET(^RCY(344.3,+RCEFT1,0)),U,10)
Begin DoDot:2
+29 WRITE !,"This receipt cannot be processed until EDI Lockbox checksum exception is",!," cleared on the EFT transmission"
+30 SET VALMSG="EDI LOCKBOX exception still exists - Receipt NOT processed"
+31 DO RET^RCDPEWL2
End DoDot:2
QUIT
+32 ;
+33 IF +$PIECE($GET(^RCY(344.31,+RCEFT,0)),U,7)'=RCAMT
Begin DoDot:2
+34 WRITE !,"This receipt cannot be processed - the receipt total does not match the",!," EFT total for this EDI Lockbox receipt"
+35 SET VALMSG="EDI LOCKBOX total of receipt not = EFT - Receipt NOT processed"
+36 DO RET^RCDPEWL2
End DoDot:2
QUIT
+37 ; Check that EFT funds were posted
+38 SET RCOK1=1
+39 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
+40 NEW RCRECTDA,RCDEPDA
+41 ; Get deposit and its receipt
SET RCDEPDA=+$PIECE($GET(^RCY(344.3,+$GET(^RCY(344.31,+RCEFT,0)),0)),U,3)
SET RCRECTDA=+$ORDER(^RCY(344,"AD",+RCDEPDA,0))
+42 ; EFT Accepted by FMS
IF RCRECTDA
SET Z=$PIECE($$FMSSTAT^RCDPUREC(RCRECTDA),U,2)
if $EXTRACT(Z)="A"
QUIT
+43 WRITE !,"This receipt cannot be processed yet - the EFT's deposit has not been",!," successfully sent to FMS. Status currently is "_Z
+44 SET VALMSG="EDI LOCKBOX EFT not yet posted"
SET RCOK1=0
+45 DO RET^RCDPEWL2
End DoDot:2
if 'RCOK1
QUIT
+46 SET RCOK=1
End DoDot:1
if 'RCOK
QUIT
+47 ;
+48 IF +$PIECE($GET(^RCY(344,RCRECTDA,0)),U,6)
IF +$PIECE(^(0),U,17)
Begin DoDot:1
+49 SET RCOK=0
+50 SET DIR("A",1)="A DEPOSIT CANNOT BE ASSOCIATED WITH AN EDI LOCKBOX EFT DETAIL RECEIPT"
+51 SET DIR(0)="YA"
SET DIR("A")="DO YOU WANT TO DELETE THIS RECEIPT'S DEPOSIT REFERENCE NOW?: "
SET DIR("B")="NO"
WRITE !
DO ^DIR
KILL DIR
+52 IF Y=1
SET DIE="^RCY(344,"
SET DR=".06///@"
SET DA=RCRECTDA
DO ^DIE
SET RCOK=1
QUIT
+53 SET VALMSG="EDI LBOX ERA receipt cannot have a deposit - Receipt NOT processed"
End DoDot:1
if 'RCOK
QUIT
+54 ;
+55 NEW RCDEPTDA,RCDPDATA,RCDPFLAG,RCDPFHLP,RCTRDA,RCSCR,STATUS,RCADJ
+56 ;
+57 ; lock receipt
+58 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
SET VALMSG="Receipt NOT Processed."
QUIT
+59 ;
+60 ; apply decrease adjustments from worklist entry
+61 SET RCSCR=+$ORDER(^RCY(344.4,"ARCT",RCRECTDA,0))
SET RCSCR=$SELECT($DATA(^RCY(344.49,+RCSCR,0)):RCSCR,1:0)
+62 SET RCADJ=$$ERAWL^RCDPRPL4(RCSCR)
+63 IF RCADJ=2
DO UNLOCK
QUIT
+64 IF RCADJ<0
Begin DoDot:1
+65 WRITE !,"The bill balance for the bills listed above must be manually increased to",!,"accommodate the automatic ERA Worklist dec adjustment amounts and to allow",!,"the ERA receipt to be balanced - Receipt NOT processed."
+66 DO UNLOCK
End DoDot:1
QUIT
+67 ;
+68 ; warning no transactions
+69 IF '$ORDER(^RCY(344,RCRECTDA,1,0))
Begin DoDot:1
+70 WRITE !,"WARNING, no transactions are on the receipt. Processing will only change"
+71 WRITE !,"the status of the receipt to closed."
End DoDot:1
+72 ;
+73 DO DIQ344^RCDPRPLM(RCRECTDA,".06;.08;.17;.18;200;")
+74 ; code sheet already sent once, this is a retransmission, check it
+75 IF RCDPDATA(344,RCRECTDA,200,"E")'=""
Begin DoDot:1
+76 SET STATUS=$$STATUS^GECSSGET(RCDPDATA(344,RCRECTDA,200,"E"))
+77 WRITE !,"This receipt has been previously processed to FMS in the cash receipt"
+78 WRITE !,"document ",$TRANSLATE(RCDPDATA(344,RCRECTDA,200,"E")," "),". The current status for this document in the"
+79 WRITE !,"Generic Code Sheet Stack file is ",STATUS,"."
+80 ;
+81 ; okay to continue if status is Error, Rejected, or not defined (-1)
+82 IF $EXTRACT(STATUS)="E"!($EXTRACT(STATUS)="R")!(STATUS=-1)
QUIT
+83 ; okay to continue if document has not been transmitted
+84 IF $EXTRACT(STATUS)="Q"!($EXTRACT(STATUS)="M")
QUIT
+85 ; okay to continue if document is transmitted for 2 days
+86 IF $EXTRACT(STATUS)="T"
IF $$FMDIFF^XLFDT(DT,RCDPDATA(344,RCRECTDA,.08,"I"))>1
QUIT
+87 ;
+88 ; do not allow reprocessing
+89 SET RCDPFLAG=1
+90 IF $EXTRACT(STATUS)="A"
WRITE !!,"You cannot reprocess and retransmit an ACCEPTED document."
+91 IF $EXTRACT(STATUS)="T"
WRITE !!,"You cannot reprocess and retransmit a document which has previously been",!,"transmitted and is waiting on confirmation (less than 2 days since",!,"processing)."
End DoDot:1
+92 IF $GET(RCDPFLAG)
DO UNLOCK
QUIT
+93 ;
+94 ; check payments to verify it doesn't exceed bill amt
+95 WRITE !!,"Checking payment amounts versus billed amounts ..."
+96 SET RCTRDA=0
FOR
SET RCTRDA=$ORDER(^RCY(344,RCRECTDA,1,RCTRDA))
if 'RCTRDA
QUIT
Begin DoDot:1
+97 SET X=$$CHECKPAY(RCRECTDA,RCTRDA)
+98 IF 'X
QUIT
+99 ; exceeds billed amt
+100 SET RCDPFLAG=1
+101 ; check for >1 pending payment for this transaction
+102 IF +$PIECE(X,"^",3)'=$PIECE(^RCY(344,RCRECTDA,1,RCTRDA,0),"^",4)
SET RCDPFLAG=2
+103 WRITE !," "
IF RCDPFLAG=2
WRITE "*"
SET RCDPFHLP=1
+104 WRITE "WARNING: Trans# ",RCTRDA,". Pending Payments $ ",$JUSTIFY($PIECE(X,"^",3),0,2)," exceed billed amount $ ",$JUSTIFY($PIECE(X,"^",2),0,2)
End DoDot:1
+105 IF $GET(RCDPFLAG)
Begin DoDot:1
+106 IF $GET(RCDPFHLP)
WRITE !,"NOTE: * Indicates more than one pending payment entered against this bill."
+107 WRITE !,"Adjust payments listed above before processing."
+108 DO UNLOCK
End DoDot:1
QUIT
+109 ;
+110 WRITE " payments okay."
+111 ;
+112 SET RCDEPTDA=RCDPDATA(344,RCRECTDA,.06,"I")
+113 ; lock deposit tckt
+114 IF RCDEPTDA
IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
DO UNLOCK
QUIT
+115 ;
+116 ; check for critical fields, deposit ticket, date of deposit
+117 ; No deposit ticket is OK for ERA not related to an EFT or for HAC ERA
+118 IF 'RCDEPTDA
IF $SELECT('$GET(RCDPDATA(344,RCRECTDA,.18,"I")):1,$$EDILB^RCDPEU(RCRECTDA)=2:0,1:'$$HAC^RCDPURE1(RCRECTDA))
Begin DoDot:1
+119 WRITE !!,"WARNING, Deposit Ticket is missing. If you continue with processing,"
+120 WRITE !,"the AR accounts will be updated and a cash receipt (CR) document will"
+121 WRITE !,"NOT be sent to FMS. You have the option to add the Deposit Ticket now."
+122 DO EDITREC^RCDPUREC(RCRECTDA,".06;")
+123 SET (RCDEPTDA,RCDPDATA(344,RCRECTDA,.06,"I"))=$PIECE(^RCY(344,RCRECTDA,0),"^",6)
End DoDot:1
+124 ;
+125 ; deposit ticket added
+126 IF RCDEPTDA
Begin DoDot:1
+127 DO EDITDEP^RCDPUDEP(RCDEPTDA,1)
+128 DO DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
+129 IF RCDPDATA(344.1,RCDEPTDA,.03,"I")
QUIT
+130 WRITE !!,"No DEPOSIT DATE, you can edit the deposit data now."
+131 DO EDITDEP^RCDPUDEP(RCDEPTDA,1)
+132 DO DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
+133 IF RCDPDATA(344.1,RCDEPTDA,.03,"I")
QUIT
+134 WRITE !!,"Still No DEPOSIT DATE, use the Edit Deposit option under Deposit Processing."
+135 SET RCDPFLAG=1
End DoDot:1
+136 IF $GET(RCDPFLAG)
DO UNLOCK
QUIT
+137 ;
+138 WRITE !
+139 IF $$ASKPROC'=1
Begin DoDot:1
+140 IF $GET(RCADJ)>0
WRITE !!,*7,"WARNING - EDI Lbox Worklist auto dec adjustments have already been made for",!,"this receipt!!!"
+141 DO UNLOCK
End DoDot:1
QUIT
+142 ;
+143 ; process receipt, pass 1 to show messages
+144 DO PROCESS^RCDPURE1(RCRECTDA,1)
KILL CSRECPT
+145 DO UNLOCK
+146 DO INIT^RCDPRPLM
+147 DO HDR^RCDPRPLM
+148 IF $PIECE(^RCY(344,RCRECTDA,0),"^",8)
SET VALMSG="Receipt PROCESSED."
+149 QUIT
+150 ;
+151 ;
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 ;
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
