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

RCDPRPL1.m

Go to the documentation of this file.
  1. RCDPRPL1 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
  1. ;;4.5;Accounts Receivable;**114,321**;Mar 20, 1995;Build 48
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ; this routine contains the entry points for payment transactions
  1. ;
  1. ;
  1. ENTRTRAN ; option: enter a payment transaction
  1. ; this option can only be selected for unapproved receipts
  1. ; screen placed in protocol file and below as backup
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
  1. ;
  1. N %,RCTRANDA,RCTYPE
  1. S RCTYPE=$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^",2)
  1. ;
  1. W !
  1. W !," Type of payment: ",$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^")
  1. W !,"Adding a NEW payment transaction: "
  1. S RCTRANDA=$$ADDTRAN^RCDPURET(RCRECTDA)
  1. I 'RCTRANDA D Q
  1. . S VALMSG="Unable to ADD a new payment transaction."
  1. . D WRITE^RCDPRPLU(VALMSG)
  1. . L -^RCY(344,RCRECTDA)
  1. ;
  1. W "# ",RCTRANDA
  1. S %=$$EDITTRAN^RCDPURET(RCRECTDA,RCTRANDA)
  1. I '% D Q
  1. . S VALMSG=%
  1. . D WRITE^RCDPRPLU(VALMSG)
  1. . L -^RCY(344,RCRECTDA)
  1. ;
  1. S VALMSG="Transaction # "_RCTRANDA_" has been ADDED."
  1. ;
  1. D INIT^RCDPRPLM
  1. L -^RCY(344,RCRECTDA)
  1. Q
  1. ;
  1. ;
  1. EDITTRAN ; option: edit a payment transaction
  1. ; this option can only be selected for unapproved receipts
  1. ; screen placed in protocol file and below as backup
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. N %,RCEEOB,RCTRANDA ; prca*4.5*321 - added RCEEOB
  1. ; select the payment transaction
  1. S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
  1. ;
  1. I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
  1. ;
  1. ; transaction is cancelled, cannot edit
  1. I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q
  1. . S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
  1. . D WRITE^RCDPRPLU(VALMSG)
  1. . L -^RCY(344,RCRECTDA)
  1. ;
  1. W !!,"Editing Payment: ",RCTRANDA
  1. S %=$$EDITTRAN^RCDPURET(RCRECTDA,RCTRANDA)
  1. I '% S VALMSG="Transaction DELETED." D WRITE^RCDPRPLU(VALMSG)
  1. ; BEGIN - PRCA*4.5*321
  1. I % D
  1. . ; Option to restore suspense EEOB
  1. . S RCEEOB=$$EEOB^RCDPEM5(RCRECTDA,RCTRANDA)
  1. . ; Update EEOB claim number and restore to active status
  1. . D:RCEEOB>0 RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"R")
  1. ; END - PRCA*4.5*321
  1. ;
  1. D INIT^RCDPRPLM
  1. L -^RCY(344,RCRECTDA)
  1. Q
  1. ;
  1. ;
  1. CANCTRAN ; option: cancel a transaction
  1. ; this option can only be selected for unapproved receipts
  1. ; screen placed in protocol file and below as backup
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. N RCTRANDA
  1. ; select the payment transaction
  1. S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
  1. ;
  1. I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
  1. ;
  1. ; check to see if already cancelled
  1. I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4)=0,$P($G(^(1)),"^")'="" D Q
  1. . S VALMSG="Payment Transaction "_RCTRANDA_" is already CANCELLED."
  1. . D WRITE^RCDPRPLU(VALMSG)
  1. . L -^RCY(344,RCRECTDA)
  1. ;
  1. ; ask to cancel
  1. I $$ASKCANC(RCTRANDA)=1 D
  1. . D CANCTRAN^RCDPURET(RCRECTDA,RCTRANDA)
  1. . S VALMSG="Transaction # "_RCTRANDA_" has been CANCELLED"
  1. ;
  1. D INIT^RCDPRPLM
  1. L -^RCY(344,RCRECTDA)
  1. Q
  1. ;
  1. ;
  1. MOVETRAN ; move a transaction from one receipt to another
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. N RCNEWREC,RCNEWTRA,RCTRANDA
  1. ; select the payment transaction
  1. S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
  1. ;
  1. I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
  1. ;
  1. ; transaction is cancelled, cannot edit
  1. I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q
  1. . S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
  1. . D WRITE^RCDPRPLU(VALMSG)
  1. . D UNLOCK
  1. ;
  1. ; select the receipt to move transaction to (can add new one)
  1. F D Q:RCNEWREC
  1. . W !!,"Select the RECEIPT to move the payment transaction #"_RCTRANDA_" to:"
  1. . S RCNEWREC=$$SELRECT^RCDPUREC(1)
  1. . I RCNEWREC<1 S RCNEWREC=-1 Q
  1. . I RCNEWREC=RCRECTDA W !,"Cannot copy transaction to same receipt." S RCNEWREC=0 Q
  1. . I '$$CHECKREC^RCDPRPLU(RCNEWREC) W !,"Cannot copy to a receipt which is CLOSED." S RCNEWREC=0 Q
  1. I RCNEWREC<1 D UNLOCK Q
  1. ;
  1. I '$$LOCKREC^RCDPRPLU(RCNEWREC) D UNLOCK Q
  1. ;
  1. W !
  1. I $P($G(^RCY(344,RCNEWREC,0)),"^",4)'=$P(^RCY(344,RCRECTDA,0),"^",4) W !,"WARNING, receipt types of payment are not the same type of payment."
  1. ;
  1. I $$ASKMOVE(RCNEWREC)'=1 D UNLOCK Q
  1. ;
  1. ; MOVETRAN will add the new transaction, and allow the user to
  1. ; edit the data. returns error message if not successful or
  1. ; returns the transaction number.
  1. S RCNEWTRA=$$MOVETRAN^RCDPURET(RCRECTDA,RCTRANDA,RCNEWREC)
  1. I 'RCNEWTRA D Q
  1. . S VALMSG=%
  1. . D WRITE^RCDPRPLU(VALMSG)
  1. . D UNLOCK
  1. ;
  1. ; delete the transaction just moved
  1. D DELETRAN^RCDPURET(RCRECTDA,RCTRANDA)
  1. ;
  1. D INIT^RCDPRPLM
  1. S VALMSG="Transaction # "_RCTRANDA_" has been MOVED/DELETED."
  1. ;
  1. UNLOCK ; unlock receipts
  1. L -^RCY(344,RCRECTDA)
  1. I $G(RCNEWREC)>0 L -^RCY(344,RCNEWREC)
  1. Q
  1. ;
  1. ;
  1. SELPAY(RCRECTDA) ; select the payment transaction for the receipt (from listmanager options)
  1. N RCTRANDA
  1. ; if no payments, quit
  1. I '$O(^RCY(344,RCRECTDA,1,0)) S VALMSG="There are NO payments." Q 0
  1. ; if only one payment, select that one automatically
  1. I $P($G(^RCY(344,RCRECTDA,1,0)),"^",4)=1 S RCTRANDA=$O(^RCY(344,RCRECTDA,1,0))
  1. ; select the payment transaction
  1. I '$G(RCTRANDA) W ! S RCTRANDA=$$SELTRAN^RCDPURET(RCRECTDA)
  1. Q RCTRANDA
  1. ;
  1. ;
  1. ASKCANC(RCTRANDA) ; ask if it's okay to cancel a transaction
  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 CANCEL transaction # "_RCTRANDA
  1. W ! D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. ;
  1. ASKMOVE(RECTDA) ; ask if its okay to move the transaction
  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 MOVE this payment to receipt "_$P($G(^RCY(344,RECTDA,0)),"^")
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y