222 lines
9.2 KiB
Mathematica
222 lines
9.2 KiB
Mathematica
RCDPRPL3 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
|
|
;;4.5;Accounts Receivable;**114,148,153,173**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, 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 RCOK,RCEFT,RCEFT1,RCHAC,RC,RCERA,RCAMT,RCQUIT,CRTR,Z
|
|
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) I $E(Z)="A" Q ; 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)
|
|
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
|
|
; 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
|