| 1 | RCDPRPL3 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
|
|---|
| 2 | ;;4.5;Accounts Receivable;**114,148,153,173**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ; routine contains the entry points for receipt management
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | EDITREC ; option: edit the receipt, deposit #
|
|---|
| 10 | D FULL^VALM1
|
|---|
| 11 | S VALMBCK="R"
|
|---|
| 12 | ;
|
|---|
| 13 | I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
|
|---|
| 14 | ;
|
|---|
| 15 | W !
|
|---|
| 16 | D EDITREC^RCDPUREC(RCRECTDA)
|
|---|
| 17 | L -^RCY(344,RCRECTDA)
|
|---|
| 18 | ;
|
|---|
| 19 | ; rebuild the header
|
|---|
| 20 | D HDR^RCDPRPLM
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | ;
|
|---|
| 24 | PROCESS ; option: process receipt
|
|---|
| 25 | N RCOK,RCEFT,RCEFT1,RCHAC,RC,RCERA,RCAMT,RCQUIT,CRTR,Z
|
|---|
| 26 | D FULL^VALM1
|
|---|
| 27 | S VALMBCK="R"
|
|---|
| 28 | ;
|
|---|
| 29 | S RC=$S('$P($G(^RCY(344,RCRECTDA,0)),U,6)&$$LBEVENT^RCDPEU():1,1:0),CRTR=$P("cash^transfer",U,RC+1)
|
|---|
| 30 | W !!,"This option will process the payments for the receipt updating the AR"
|
|---|
| 31 | W !,"Package and generate the "_CRTR_" receipt document to FMS. Any decrease"
|
|---|
| 32 | W !,"adjustments entered via the EDI Lockbox Worklist will also be generated."
|
|---|
| 33 | W !,"Once a receipt has been processed, the receipt status will change to closed"
|
|---|
| 34 | W !,"and no further processing of the receipt can occur. If the FMS "_CRTR
|
|---|
| 35 | W !," receipt document rejects, you can use this same option to reprocess the"
|
|---|
| 36 | W !,"receipt.",!
|
|---|
| 37 | ;
|
|---|
| 38 | S RCEFT=+$P($G(^RCY(344,RCRECTDA,0)),U,17),RCERA=$P($G(^(0)),U,18),RCHAC=0
|
|---|
| 39 | S RCAMT=+$$PAYTOTAL^RCDPURED(RCRECTDA)
|
|---|
| 40 | ;
|
|---|
| 41 | S RCQUIT=0
|
|---|
| 42 | I RCERA,'RCEFT D Q:RCQUIT
|
|---|
| 43 | . I +$P($G(^RCY(344.4,+RCERA,0)),U,5)'=RCAMT D S RCQUIT=1 Q
|
|---|
| 44 | .. 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)_")"
|
|---|
| 45 | .. S VALMSG="Receipt total not = ERA total - Receipt NOT processed"
|
|---|
| 46 | .. D RET^RCDPEWL2
|
|---|
| 47 | ;
|
|---|
| 48 | I RCEFT D Q:'RCOK
|
|---|
| 49 | . N RCOK1
|
|---|
| 50 | . S RCOK=0,RCEFT1=+$G(^RCY(344.3,+RCEFT,0)),RCHAC=($E($P($G(^RCY(344.3,RCEFT1,0)),U,6),1,3)="HAC")
|
|---|
| 51 | . N Z,DIR,DIE,DA,DR
|
|---|
| 52 | . I $P($G(^RCY(344.3,+RCEFT1,0)),U,10) D Q
|
|---|
| 53 | .. W !,"This receipt cannot be processed until EDI Lockbox checksum exception is",!," cleared on the EFT transmission"
|
|---|
| 54 | .. S VALMSG="EDI LOCKBOX exception still exists - Receipt NOT processed"
|
|---|
| 55 | .. D RET^RCDPEWL2
|
|---|
| 56 | . ;
|
|---|
| 57 | . I +$P($G(^RCY(344.31,+RCEFT,0)),U,7)'=RCAMT D Q
|
|---|
| 58 | .. W !,"This receipt cannot be processed - the receipt total does not match the",!," EFT total for this EDI Lockbox receipt"
|
|---|
| 59 | .. S VALMSG="EDI LOCKBOX total of receipt not = EFT - Receipt NOT processed"
|
|---|
| 60 | .. D RET^RCDPEWL2
|
|---|
| 61 | . ; Check that EFT funds were posted
|
|---|
| 62 | . S RCOK1=1
|
|---|
| 63 | . 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
|
|---|
| 64 | .. N RCRECTDA,RCDEPDA
|
|---|
| 65 | .. 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
|
|---|
| 66 | .. I RCRECTDA S Z=$P($$FMSSTAT^RCDPUREC(RCRECTDA),U,2) I $E(Z)="A" Q ; Accepted by FMS
|
|---|
| 67 | .. W !,"This receipt cannot be processed yet - the EFT's deposit has not been",!," successfully sent to FMS. Status currently is "_Z
|
|---|
| 68 | .. S VALMSG="EDI LOCKBOX EFT not yet posted",RCOK1=0
|
|---|
| 69 | .. D RET^RCDPEWL2
|
|---|
| 70 | . S RCOK=1
|
|---|
| 71 | ;
|
|---|
| 72 | I +$P($G(^RCY(344,RCRECTDA,0)),U,6),+$P(^(0),U,17) D Q:'RCOK
|
|---|
| 73 | . S RCOK=0
|
|---|
| 74 | . S DIR("A",1)="A DEPOSIT CANNOT BE ASSOCIATED WITH AN EDI LOCKBOX EFT DETAIL RECEIPT"
|
|---|
| 75 | . 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
|
|---|
| 76 | . I Y=1 S DIE="^RCY(344,",DR=".06///@",DA=RCRECTDA D ^DIE S RCOK=1 Q
|
|---|
| 77 | . S VALMSG="EDI LBOX ERA receipt cannot have a deposit - Receipt NOT processed"
|
|---|
| 78 | ;
|
|---|
| 79 | N RCDEPTDA,RCDPDATA,RCDPFLAG,RCDPFHLP,RCTRDA,RCSCR,STATUS,RCADJ
|
|---|
| 80 | ;
|
|---|
| 81 | ; lock receipt
|
|---|
| 82 | I '$$LOCKREC^RCDPRPLU(RCRECTDA) S VALMSG="Receipt NOT Processed." Q
|
|---|
| 83 | ;
|
|---|
| 84 | ; apply decrease adjustments from worklist entry
|
|---|
| 85 | S RCSCR=+$O(^RCY(344.4,"ARCT",RCRECTDA,0)),RCSCR=$S($D(^RCY(344.49,+RCSCR,0)):RCSCR,1:0)
|
|---|
| 86 | S RCADJ=$$ERAWL^RCDPRPL4(RCSCR)
|
|---|
| 87 | I RCADJ=2 D UNLOCK Q
|
|---|
| 88 | I RCADJ<0 D Q
|
|---|
| 89 | . 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."
|
|---|
| 90 | . D UNLOCK
|
|---|
| 91 | ;
|
|---|
| 92 | ; warning no transactions
|
|---|
| 93 | I '$O(^RCY(344,RCRECTDA,1,0)) D
|
|---|
| 94 | . W !,"WARNING, no transactions are on the receipt. Processing will only change"
|
|---|
| 95 | . W !,"the status of the receipt to closed."
|
|---|
| 96 | ;
|
|---|
| 97 | D DIQ344^RCDPRPLM(RCRECTDA,".06;.08;.17;.18;200;")
|
|---|
| 98 | ; code sheet already sent once, this is a retransmission, check it
|
|---|
| 99 | I RCDPDATA(344,RCRECTDA,200,"E")'="" D
|
|---|
| 100 | . S STATUS=$$STATUS^GECSSGET(RCDPDATA(344,RCRECTDA,200,"E"))
|
|---|
| 101 | . W !,"This receipt has been previously processed to FMS in the cash receipt"
|
|---|
| 102 | . W !,"document ",$TR(RCDPDATA(344,RCRECTDA,200,"E")," "),". The current status for this document in the"
|
|---|
| 103 | . W !,"Generic Code Sheet Stack file is ",STATUS,"."
|
|---|
| 104 | . ;
|
|---|
| 105 | . ; okay to continue if status is Error, Rejected, or not defined (-1)
|
|---|
| 106 | . I $E(STATUS)="E"!($E(STATUS)="R")!(STATUS=-1) Q
|
|---|
| 107 | . ; okay to continue if document has not been transmitted
|
|---|
| 108 | . I $E(STATUS)="Q"!($E(STATUS)="M") Q
|
|---|
| 109 | . ; okay to continue if document is transmitted for 2 days
|
|---|
| 110 | . I $E(STATUS)="T",$$FMDIFF^XLFDT(DT,RCDPDATA(344,RCRECTDA,.08,"I"))>1 Q
|
|---|
| 111 | . ;
|
|---|
| 112 | . ; do not allow reprocessing
|
|---|
| 113 | . S RCDPFLAG=1
|
|---|
| 114 | . I $E(STATUS)="A" W !!,"You cannot reprocess and retransmit an ACCEPTED document."
|
|---|
| 115 | . 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)."
|
|---|
| 116 | I $G(RCDPFLAG) D UNLOCK Q
|
|---|
| 117 | ;
|
|---|
| 118 | ; check payments to verify it doesn't exceed bill amt
|
|---|
| 119 | W !!,"Checking payment amounts versus billed amounts ..."
|
|---|
| 120 | S RCTRDA=0 F S RCTRDA=$O(^RCY(344,RCRECTDA,1,RCTRDA)) Q:'RCTRDA D
|
|---|
| 121 | . S X=$$CHECKPAY(RCRECTDA,RCTRDA)
|
|---|
| 122 | . I 'X Q
|
|---|
| 123 | . ; exceeds billed amt
|
|---|
| 124 | . S RCDPFLAG=1
|
|---|
| 125 | . ; check for >1 pending payment for this transaction
|
|---|
| 126 | . I +$P(X,"^",3)'=$P(^RCY(344,RCRECTDA,1,RCTRDA,0),"^",4) S RCDPFLAG=2
|
|---|
| 127 | . W !," " I RCDPFLAG=2 W "*" S RCDPFHLP=1
|
|---|
| 128 | . W "WARNING: Trans# ",RCTRDA,". Pending Payments $ ",$J($P(X,"^",3),0,2)," exceed billed amount $ ",$J($P(X,"^",2),0,2)
|
|---|
| 129 | I $G(RCDPFLAG) D Q
|
|---|
| 130 | . I $G(RCDPFHLP) W !,"NOTE: * Indicates more than one pending payment entered against this bill."
|
|---|
| 131 | . W !,"Adjust payments listed above before processing."
|
|---|
| 132 | . D UNLOCK
|
|---|
| 133 | ;
|
|---|
| 134 | W " payments okay."
|
|---|
| 135 | ;
|
|---|
| 136 | S RCDEPTDA=RCDPDATA(344,RCRECTDA,.06,"I")
|
|---|
| 137 | ; lock deposit tckt
|
|---|
| 138 | I RCDEPTDA I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) D UNLOCK Q
|
|---|
| 139 | ;
|
|---|
| 140 | ; check for critical fields, deposit ticket, date of deposit
|
|---|
| 141 | ; No deposit ticket is OK for ERA not related to an EFT or for HAC ERA
|
|---|
| 142 | I 'RCDEPTDA,$S('$G(RCDPDATA(344,RCRECTDA,.18,"I")):1,$$EDILB^RCDPEU(RCRECTDA)=2:0,1:'$$HAC^RCDPURE1(RCRECTDA)) D
|
|---|
| 143 | . W !!,"WARNING, Deposit Ticket is missing. If you continue with processing,"
|
|---|
| 144 | . W !,"the AR accounts will be updated and a cash receipt (CR) document will"
|
|---|
| 145 | . W !,"NOT be sent to FMS. You have the option to add the Deposit Ticket now."
|
|---|
| 146 | . D EDITREC^RCDPUREC(RCRECTDA,".06;")
|
|---|
| 147 | . S (RCDEPTDA,RCDPDATA(344,RCRECTDA,.06,"I"))=$P(^RCY(344,RCRECTDA,0),"^",6)
|
|---|
| 148 | ;
|
|---|
| 149 | ; deposit ticket added
|
|---|
| 150 | I RCDEPTDA D
|
|---|
| 151 | . D EDITDEP^RCDPUDEP(RCDEPTDA,1)
|
|---|
| 152 | . D DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
|
|---|
| 153 | . I RCDPDATA(344.1,RCDEPTDA,.03,"I") Q
|
|---|
| 154 | . W !!,"No DEPOSIT DATE, you can edit the deposit data now."
|
|---|
| 155 | . D EDITDEP^RCDPUDEP(RCDEPTDA,1)
|
|---|
| 156 | . D DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
|
|---|
| 157 | . I RCDPDATA(344.1,RCDEPTDA,.03,"I") Q
|
|---|
| 158 | . W !!,"Still No DEPOSIT DATE, use the Edit Deposit option under Deposit Processing."
|
|---|
| 159 | . S RCDPFLAG=1
|
|---|
| 160 | I $G(RCDPFLAG) D UNLOCK Q
|
|---|
| 161 | ;
|
|---|
| 162 | W !
|
|---|
| 163 | I $$ASKPROC'=1 D Q
|
|---|
| 164 | . I $G(RCADJ)>0 W !!,*7,"WARNING - EDI Lbox Worklist auto dec adjustments have already been made for",!,"this receipt!!!"
|
|---|
| 165 | . D UNLOCK
|
|---|
| 166 | ;
|
|---|
| 167 | ; process receipt, pass 1 to show messages
|
|---|
| 168 | D PROCESS^RCDPURE1(RCRECTDA,1)
|
|---|
| 169 | D UNLOCK
|
|---|
| 170 | D INIT^RCDPRPLM
|
|---|
| 171 | D HDR^RCDPRPLM
|
|---|
| 172 | I $P(^RCY(344,RCRECTDA,0),"^",8) S VALMSG="Receipt PROCESSED."
|
|---|
| 173 | Q
|
|---|
| 174 | ;
|
|---|
| 175 | ;
|
|---|
| 176 | UNLOCK ; unlock/pause
|
|---|
| 177 | L -^RCY(344,RCRECTDA)
|
|---|
| 178 | I $G(RCDEPTDA) L -^RCY(344.1,RCDEPTDA)
|
|---|
| 179 | W !!,"Press RETURN to continue: " R X:DTIME
|
|---|
| 180 | S VALMSG="Receipt NOT Processed."
|
|---|
| 181 | D HDR^RCDPRPLM
|
|---|
| 182 | Q
|
|---|
| 183 | ;
|
|---|
| 184 | ;
|
|---|
| 185 | CHECKPAY(RCRECTDA,RCTRDA) ; called to check amt pd against amt of bill
|
|---|
| 186 | N PAYDATA,PENDING,X
|
|---|
| 187 | ; receipt already processed
|
|---|
| 188 | I $P($G(^RCY(344,RCRECTDA,0)),"^",7) Q 0
|
|---|
| 189 | S PAYDATA=$G(^RCY(344,RCRECTDA,1,RCTRDA,0))
|
|---|
| 190 | ; payment is 0
|
|---|
| 191 | I '$P(PAYDATA,"^",4) Q 0
|
|---|
| 192 | ; payment processed
|
|---|
| 193 | I $P(PAYDATA,"^",5) Q 0
|
|---|
| 194 | ; not a bill
|
|---|
| 195 | I $P(PAYDATA,"^",3)'["PRCA(430," Q 0
|
|---|
| 196 | ; first party bill (do not check dollars)
|
|---|
| 197 | I $P($G(^RCD(340,+$P($G(^PRCA(430,+$P(PAYDATA,"^",3),0)),"^",9),0)),"^")["DPT(" Q 0
|
|---|
| 198 | ; bill not activated or open
|
|---|
| 199 | S X=$P($G(^PRCA(430,+$P(PAYDATA,"^",3),0)),"^",8)
|
|---|
| 200 | I X'=42,X'=16 Q "1^0"
|
|---|
| 201 | ; calculate dollars on receivable
|
|---|
| 202 | S X=$G(^PRCA(430,+$P(PAYDATA,"^",3),7)),X=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
|
|---|
| 203 | ; get pending payments
|
|---|
| 204 | ; use pending since there may be more than one payment
|
|---|
| 205 | ; to the same bill on the receipt
|
|---|
| 206 | S PENDING=$$PENDPAY^RCDPURET($P(PAYDATA,"^",3))
|
|---|
| 207 | K ^TMP($J,"RCDPUREC","PP") ;set by pending payment call
|
|---|
| 208 | ; pending payments is not > billed
|
|---|
| 209 | I PENDING'>X Q 0
|
|---|
| 210 | ; greater, return billed amt ^ pending payment amt
|
|---|
| 211 | Q "1^"_X_"^"_PENDING
|
|---|
| 212 | ;
|
|---|
| 213 | ;
|
|---|
| 214 | ASKPROC() ; ask if its okay to process the receipt
|
|---|
| 215 | ; 1 is yes, otherwise no
|
|---|
| 216 | N DIR,DIQ2,DTOUT,DUOUT,X,Y
|
|---|
| 217 | S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 218 | S DIR("A")=" Are you sure you want to PROCESS this receipt"
|
|---|
| 219 | D ^DIR
|
|---|
| 220 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
|---|
| 221 | Q Y
|
|---|
