Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPRPL3

RCDPRPL3.m

Go to the documentation of this file. 
  1. RCDPRPL3 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
  1.  ;;4.5;Accounts Receivable;**114,148,153,173,301,326,367,371,409,424**;Mar 20, 1995;Build 11
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1.  ;  routine contains the entry points for receipt management
  1.  ;
  1.  ;
  1. EDITREC ;  option: edit the receipt, deposit #
  1.  N RCPAYTYP                                     ;PRCA*4.5*409 - Added line
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  S RCPAYTYP=$P(^RCY(344,RCRECTDA,0),"^",4)      ;PRCA*4.5*409 - AR Event Type IEN
  1.  ;
  1.  ; PRCA*4.5*409 Added if - Prevent editing of Receipts with payment types of OGC-EFT
  1.  I RCPAYTYP=18 D  Q
  1.  . N NEWEFT,OLDEFT
  1.  . I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
  1.  . S OLDEFT=$P($G(^RCY(344,RCRECTDA,0)),U,17)
  1.  . S NEWEFT=$$ASK17^RCDPUREC(RCRECTDA)
  1.  . I NEWEFT,NEWEFT'=OLDEFT D EDITREC2^RCDPUREC(RCRECTDA,OLDEFT,NEWEFT)
  1.  . D PAUSE
  1.  . L -^RCY(344,RCRECTDA)
  1.  . D HDR^RCDPRPLM
  1.  ;
  1.  ; PRCA*4.5*409 Added if - Prevent editing of Receipts with payment types of OGC-CHK
  1.  I RCPAYTYP=19 D  Q
  1.  . W *7,!,"Receipts with a Payment Type of OGC-CHK cannot be edited"
  1.  . D PAUSE
  1.  ;
  1.  I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
  1.  ;
  1.  W !
  1.  D EDITREC^RCDPUREC(RCRECTDA)
  1.  L -^RCY(344,RCRECTDA)
  1.  ;
  1.  ;  rebuild the header
  1.  D HDR^RCDPRPLM
  1.  Q
  1.  ;
  1. PAUSE() ; Pause at end of each page for user input
  1.  ; PRCA*4.5*409 Added function
  1.  ; Input:   None
  1.  ; Returns: None
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR("A")="Press return to continue"
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  Q Y
  1.  ;
  1. PROCESS ;  option: process receipt
  1.  N CRTR,RC,RCAMT,RCHMP,RCEFT,RCEFT1,RCERA,RCHAC,RCOK,RCQUIT,X,XX,Z  ;PRCA*4.5*409 Added XX,YY; PRCA*4.5*424 Removed YY
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  ;
  1.  S RC=$S('$P($G(^RCY(344,RCRECTDA,0)),U,6)&$$LBEVENT^RCDPEU():1,1:0),CRTR=$P("cash^transfer",U,RC+1)
  1.  W !!,"This option will process the payments for the receipt updating the AR"
  1.  W !,"Package and generate the "_CRTR_" receipt document to FMS.  Any decrease"
  1.  W !,"adjustments entered via the EDI Lockbox Worklist will also be generated."
  1.  W !,"Once a receipt has been processed, the receipt status will change to closed"
  1.  W !,"and no further processing of the receipt can occur.  If the FMS "_CRTR
  1.  W !," receipt document rejects, you can use this same option to reprocess the"
  1.  W !,"receipt.",!
  1.  ;
  1.  S RCEFT=+$P($G(^RCY(344,RCRECTDA,0)),U,17),RCERA=$P($G(^(0)),U,18),RCHAC=0
  1.  S RCAMT=+$$PAYTOTAL^RCDPURED(RCRECTDA)
  1.  ;
  1.  S RCQUIT=0
  1.  I RCERA,'RCEFT D  Q:RCQUIT
  1.  . I +$P($G(^RCY(344.4,+RCERA,0)),U,5)'=RCAMT D  S RCQUIT=1 Q
  1.  . . W !,"This receipt cannot be processed because the total amount of the associated"
  1.  . . 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)_")"
  1.  . . S VALMSG="Receipt total not = ERA total - Receipt NOT processed"
  1.  . . D RET^RCDPEWL2
  1.  ;
  1.  I RCEFT D  Q:'RCOK
  1.  . N RCOK1
  1.  . S RCOK=0,RCEFT1=+$G(^RCY(344.3,+RCEFT,0)),RCHAC=($E($P($G(^RCY(344.3,RCEFT1,0)),U,6),1,3)="HAC")
  1.  . N Z,DIR,DIE,DA,DR
  1.  . I $P($G(^RCY(344.3,+RCEFT1,0)),U,10) D  Q
  1.  . . W !,"This receipt cannot be processed until EDI Lockbox checksum exception is"
  1.  . . W !," cleared on the EFT transmission"
  1.  . . S VALMSG="EDI LOCKBOX exception still exists - Receipt NOT processed"
  1.  . . D RET^RCDPEWL2
  1.  . ;
  1.  . I +$P($G(^RCY(344.31,+RCEFT,0)),U,7)'=RCAMT D  Q
  1.  . . W !,"This receipt cannot be processed - the receipt total does not match the"
  1.  . . W !," EFT total for this EDI Lockbox receipt"
  1.  . . S VALMSG="EDI LOCKBOX total of receipt not = EFT - Receipt NOT processed"
  1.  . . D RET^RCDPEWL2
  1.  . ;
  1.  . ; Check that EFT funds were posted
  1.  . S RCOK1=1
  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
  1.  . . N RCRECTDA,RCDEPDA
  1.  . . S RCDEPDA=+$P($G(^RCY(344.3,+$G(^RCY(344.31,+RCEFT,0)),0)),U,3)
  1.  . . S RCRECTDA=+$O(^RCY(344,"AD",+RCDEPDA,0)) ; Get deposit and its receipt
  1.  . . 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
  1.  . . W !,"This receipt cannot be processed yet - the EFT's deposit has not been"
  1.  . . W !," successfully sent to FMS.  Status currently is "_Z
  1.  . . S VALMSG="EDI LOCKBOX EFT not yet posted",RCOK1=0
  1.  . . D RET^RCDPEWL2
  1.  . S RCOK=1
  1.  ;
  1.  ; PRCA*4.5*367 - If CHAMPVA receipt, check against receipt total field
  1.  S RCHMP=$$ISCHMPVA^RCDPUREC(+$P($G(^RCY(344,RCRECTDA,0)),U,4))
  1.  I RCHMP D  Q:RCQUIT
  1.  . N I,RCTOT,TXTOT
  1.  . S RCTOT=+$P($G(^RCY(344,RCRECTDA,0)),U,22),TXTOT=0
  1.  . S I=0 F  S I=$O(^RCY(344,RCRECTDA,1,I)) Q:'+I  D
  1.  . . S TXTOT=TXTOT+$P(^RCY(344,RCRECTDA,1,I,0),U,4)
  1.  . I RCTOT'=TXTOT D
  1.  . . S RCQUIT=1
  1.  . . W !,"This receipt cannot be processed because the RECEIPT TOTAL does not equal"
  1.  . . W !," does not equal the total amount on the receipt ("_$J(RCAMT,"",2)_")"
  1.  . . S VALMSG="Receipt total not match RECEIPT TOTAL"
  1.  . . D RET^RCDPEWL2
  1.  ;
  1.  I +$P($G(^RCY(344,RCRECTDA,0)),U,6),+$P(^(0),U,17) D  Q:'RCOK
  1.  . S RCOK=0
  1.  . S DIR("A",1)="A DEPOSIT CANNOT BE ASSOCIATED WITH AN EDI LOCKBOX EFT DETAIL RECEIPT"
  1.  . S DIR(0)="YA",DIR("A")="DO YOU WANT TO DELETE THIS RECEIPT'S DEPOSIT REFERENCE NOW?: "
  1.  . S DIR("B")="NO"
  1.  . W ! D ^DIR K DIR
  1.  . I Y=1 S DIE="^RCY(344,",DR=".06///@",DA=RCRECTDA D ^DIE S RCOK=1 Q
  1.  . S VALMSG="EDI LBOX ERA receipt cannot have a deposit - Receipt NOT processed"
  1.  ;
  1.  N RCDEPTDA,RCDPDATA,RCDPFLAG,RCDPFHLP,RCTRDA,RCSCR,STATUS,RCADJ
  1.  ;
  1.  ; Lock receipt
  1.  I '$$LOCKREC^RCDPRPLU(RCRECTDA) S VALMSG="Receipt NOT Processed." Q
  1.  ;
  1.  ; Apply decrease adjustments from worklist entry
  1.  S RCSCR=+$O(^RCY(344.4,"ARCT",RCRECTDA,0)),RCSCR=$S($D(^RCY(344.49,+RCSCR,0)):RCSCR,1:0)
  1.  S RCADJ=$$ERAWL^RCDPRPL4(RCSCR)
  1.  I RCADJ=2 D UNLOCK Q
  1.  I RCADJ<0 D  Q
  1.  . W !,"The bill balance for the bills listed above must be manually increased to"
  1.  . W !,"accommodate the automatic ERA Worklist dec adjustment amounts and to allow"
  1.  . W !,"the ERA receipt to be balanced - Receipt NOT processed."
  1.  . D UNLOCK
  1.  ;
  1.  ; Warning no transactions
  1.  I '$O(^RCY(344,RCRECTDA,1,0)) D
  1.  . W !,"WARNING, no transactions are on the receipt.  Processing will only change"
  1.  . W !,"the status of the receipt to closed."
  1.  ;
  1.  D DIQ344^RCDPRPLM(RCRECTDA,".04;.06;.08;.17;.18;200;")     ;PRCA*4.5*409 Added .04;
  1.  ;
  1.  ; Code sheet already sent once, this is a retransmission, check it
  1.  I RCDPDATA(344,RCRECTDA,200,"E")'="" D
  1.  . S STATUS=$$STATUS^GECSSGET(RCDPDATA(344,RCRECTDA,200,"E"))
  1.  . W !,"This receipt has been previously processed to FMS in the cash receipt"
  1.  . W !,"document ",$TR(RCDPDATA(344,RCRECTDA,200,"E")," ")
  1.  . W ".  The current status for this document in the"
  1.  . W !,"Generic Code Sheet Stack file is ",STATUS,"."
  1.  . ;
  1.  . ; Okay to continue if status is Error, Rejected, or not defined (-1)
  1.  . I $E(STATUS)="E"!($E(STATUS)="R")!(STATUS=-1) Q
  1.  . ;
  1.  . ; Okay to continue if document has not been transmitted
  1.  . I $E(STATUS)="Q"!($E(STATUS)="M") Q
  1.  . ;
  1.  . ; Okay to continue if document is transmitted for 2 days
  1.  . I $E(STATUS)="T",$$FMDIFF^XLFDT(DT,RCDPDATA(344,RCRECTDA,.08,"I"))>1 Q
  1.  . ;
  1.  . ; Do not allow reprocessing
  1.  . S RCDPFLAG=1
  1.  . I $E(STATUS)="A" W !!,"You cannot reprocess and retransmit an ACCEPTED document."
  1.  . I $E(STATUS)="T" D
  1.  . . W !!,"You cannot reprocess and retransmit a document which has previously been"
  1.  . . W !,"transmitted and is waiting on confirmation (less than 2 days since",!,"processing)."
  1.  I $G(RCDPFLAG) D UNLOCK Q
  1.  ;
  1.  ; Check payments to verify it doesn't exceed bill amt
  1.  W !!,"Checking payment amounts versus billed amounts ..."
  1.  S RCTRDA=0 F  S RCTRDA=$O(^RCY(344,RCRECTDA,1,RCTRDA)) Q:'RCTRDA  D
  1.  . S X=$$CHECKPAY(RCRECTDA,RCTRDA)
  1.  . I 'X Q
  1.  . ;
  1.  . ; Exceeds billed amt
  1.  . S RCDPFLAG=1
  1.  . ;
  1.  . ; Check for >1 pending payment for this transaction
  1.  . I +$P(X,"^",3)'=$P(^RCY(344,RCRECTDA,1,RCTRDA,0),"^",4) S RCDPFLAG=2
  1.  . W !," " I RCDPFLAG=2 W "*" S RCDPFHLP=1
  1.  . W "WARNING: Trans# ",RCTRDA,". Pending Payments $ ",$J($P(X,"^",3),0,2)
  1.  . W " exceed billed amount $ ",$J($P(X,"^",2),0,2)
  1.  I $G(RCDPFLAG) D  Q
  1.  . I $G(RCDPFHLP) W !,"NOTE: * Indicates more than one pending payment entered against this bill."
  1.  . W !,"Adjust payments listed above before processing."
  1.  . D UNLOCK
  1.  ;
  1.  W "  payments okay."
  1.  ;
  1.  S RCDEPTDA=RCDPDATA(344,RCRECTDA,.06,"I")
  1.  I RCDEPTDA I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) D UNLOCK Q      ; Lock deposit ticket
  1.  ;
  1.  ; Check for critical fields, deposit ticket, date of deposit
  1.  ; No deposit ticket is OK for ERA not related to an EFT or for HAC ERA
  1.  ; PRCA*4.5*367 - Do not create deposit ticket for CHAMPVA receipts
  1.  ; PRCA*4.5*371 - EDI LOCKBOX type Receipts have an EFT and don't need a deposit #
  1.  S XX=$S('$G(RCDPDATA(344,RCRECTDA,.18,"I")):1,$$EDILB^RCDPEU(RCRECTDA)=2:0,1:'$$HAC^RCDPURE1(RCRECTDA))
  1.  I 'RCEFT,'RCHMP,'RCDEPTDA,XX D
  1.  . W !!,"WARNING, Deposit Ticket is missing.  If you continue with processing,"
  1.  . W !,"the AR accounts will be updated and a cash receipt (CR) document will"
  1.  . W !,"NOT be sent to FMS.  You have the option to add the Deposit Ticket now."
  1.  . D EDITREC^RCDPUREC(RCRECTDA,".06;")
  1.  . S (RCDEPTDA,RCDPDATA(344,RCRECTDA,.06,"I"))=$P(^RCY(344,RCRECTDA,0),"^",6)
  1.  ;
  1.  ; PRCA*4.5*424 - Removed requirement for deposit ticket on CHECK/MO and OGC-CHK receipts
  1.  ;
  1.  ; Deposit ticket added
  1.  I RCDEPTDA D
  1.  . D EDITDEP^RCDPUDEP(RCDEPTDA,1)
  1.  . D DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
  1.  . I RCDPDATA(344.1,RCDEPTDA,.03,"I") Q
  1.  . W !!,"No DEPOSIT DATE, you can edit the deposit data now."
  1.  . D EDITDEP^RCDPUDEP(RCDEPTDA,1)
  1.  . D DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
  1.  . I RCDPDATA(344.1,RCDEPTDA,.03,"I") Q
  1.  . W !!,"Still No DEPOSIT DATE, use the Edit Deposit option under Deposit Processing."
  1.  . S RCDPFLAG=1
  1.  I $G(RCDPFLAG) D UNLOCK Q
  1.  ;
  1.  W !
  1.  I $$ASKPROC'=1 D  Q
  1.  . I $G(RCADJ)>0 D
  1.  . . W !!,*7,"WARNING - EDI Lbox Worklist auto dec adjustments have already been made for"
  1.  . . W !,"this receipt!!!"
  1.  . D UNLOCK
  1.  ;
  1.  ; Process receipt, pass 1 to show messages
  1.  D PROCESS^RCDPURE1(RCRECTDA,1) K CSRECPT
  1.  D UNLOCK
  1.  D INIT^RCDPRPLM
  1.  D HDR^RCDPRPLM
  1.  I $P(^RCY(344,RCRECTDA,0),"^",8) S VALMSG="Receipt PROCESSED."
  1.  Q
  1.  ;
  1. UNLOCK ; Unlock/pause
  1.  L -^RCY(344,RCRECTDA)
  1.  I $G(RCDEPTDA) L -^RCY(344.1,RCDEPTDA)
  1.  W !!,"Press RETURN to continue: " R X:DTIME
  1.  S VALMSG="Receipt NOT Processed."
  1.  D HDR^RCDPRPLM
  1.  Q
  1.  ;
  1.  ;PRCA*4.5*409 Added Method
  1. TXLINE(RCRECTDA) ; Check if the receipt has at least one transaction that is not cancelled
  1.  ; Input:   RCRECTDA    - IEN of the Receipt (File #344)
  1.  ; Returns: 1 if at least one non-cancelled transaction line exists, 0 otherwise
  1.  N FOUND,TXLINE
  1.  S FOUND=0,TXLINE=0
  1.  F  D  Q:+TXLINE=0  Q:FOUND
  1.  . S TXLINE=$O(^RCY(344,RCRECTDA,1,TXLINE))
  1.  . Q:+TXLINE=0
  1.  . S:'$D(^RCY(344,RCRECTDA,1,TXLINE,1)) FOUND=1
  1.  Q FOUND
  1.  ;
  1. CHECKPAY(RCRECTDA,RCTRDA) ;  called to check amt pd against amt of bill
  1.  N PAYDATA,PENDING,X
  1.  ;  receipt already processed
  1.  I $P($G(^RCY(344,RCRECTDA,0)),"^",7) Q 0
  1.  S PAYDATA=$G(^RCY(344,RCRECTDA,1,RCTRDA,0))
  1.  ;  payment is 0
  1.  I '$P(PAYDATA,"^",4) Q 0
  1.  ;  payment processed
  1.  I $P(PAYDATA,"^",5) Q 0
  1.  ;  not a bill
  1.  I $P(PAYDATA,"^",3)'["PRCA(430," Q 0
  1.  ;  first party bill (do not check dollars)
  1.  I $P($G(^RCD(340,+$P($G(^PRCA(430,+$P(PAYDATA,"^",3),0)),"^",9),0)),"^")["DPT(" Q 0
  1.  ; TCSP bill, no payments allowed   prca*4.5*301 BB
  1.  I $D(^PRCA(430,"TCSP",+$P(PAYDATA,"^",3))) Q 0
  1.  ;  bill not activated or open
  1.  S X=$P($G(^PRCA(430,+$P(PAYDATA,"^",3),0)),"^",8)
  1.  I X'=42,X'=16 Q "1^0"
  1.  ;  calculate dollars on receivable
  1.  S X=$G(^PRCA(430,+$P(PAYDATA,"^",3),7)),X=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
  1.  ;  get pending payments
  1.  ;  use pending since there may be more than one payment
  1.  ;  to the same bill on the receipt
  1.  S PENDING=$$PENDPAY^RCDPURET($P(PAYDATA,"^",3))
  1.  K ^TMP($J,"RCDPUREC","PP") ;set by pending payment call
  1.  ;  pending payments is not > billed
  1.  I PENDING'>X Q 0
  1.  ;  greater, return billed amt ^ pending payment amt
  1.  Q "1^"_X_"^"_PENDING
  1.  ;
  1.  ;
  1. ASKPROC() ;  ask if its okay to process the receipt
  1.  ;  1 is yes, otherwise no
  1.  N DIR,DIQ2,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="YO",DIR("B")="NO"
  1.  S DIR("A")="  Are you sure you want to PROCESS this receipt"
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1.  Q Y