- RCDPRPL1 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
- ;;4.5;Accounts Receivable;**114,321**;Mar 20, 1995;Build 48
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ; this routine contains the entry points for payment transactions
- ;
- ;
- ENTRTRAN ; option: enter a payment transaction
- ; this option can only be selected for unapproved receipts
- ; screen placed in protocol file and below as backup
- D FULL^VALM1
- S VALMBCK="R"
- ;
- I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
- ;
- N %,RCTRANDA,RCTYPE
- S RCTYPE=$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^",2)
- ;
- W !
- W !," Type of payment: ",$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^")
- W !,"Adding a NEW payment transaction: "
- S RCTRANDA=$$ADDTRAN^RCDPURET(RCRECTDA)
- I 'RCTRANDA D Q
- . S VALMSG="Unable to ADD a new payment transaction."
- . D WRITE^RCDPRPLU(VALMSG)
- . L -^RCY(344,RCRECTDA)
- ;
- W "# ",RCTRANDA
- S %=$$EDITTRAN^RCDPURET(RCRECTDA,RCTRANDA)
- I '% D Q
- . S VALMSG=%
- . D WRITE^RCDPRPLU(VALMSG)
- . L -^RCY(344,RCRECTDA)
- ;
- S VALMSG="Transaction # "_RCTRANDA_" has been ADDED."
- ;
- D INIT^RCDPRPLM
- L -^RCY(344,RCRECTDA)
- Q
- ;
- ;
- EDITTRAN ; option: edit a payment transaction
- ; this option can only be selected for unapproved receipts
- ; screen placed in protocol file and below as backup
- D FULL^VALM1
- S VALMBCK="R"
- ;
- N %,RCEEOB,RCTRANDA ; prca*4.5*321 - added RCEEOB
- ; select the payment transaction
- S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
- ;
- I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
- ;
- ; transaction is cancelled, cannot edit
- I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q
- . S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
- . D WRITE^RCDPRPLU(VALMSG)
- . L -^RCY(344,RCRECTDA)
- ;
- W !!,"Editing Payment: ",RCTRANDA
- S %=$$EDITTRAN^RCDPURET(RCRECTDA,RCTRANDA)
- I '% S VALMSG="Transaction DELETED." D WRITE^RCDPRPLU(VALMSG)
- ; BEGIN - PRCA*4.5*321
- I % D
- . ; Option to restore suspense EEOB
- . S RCEEOB=$$EEOB^RCDPEM5(RCRECTDA,RCTRANDA)
- . ; Update EEOB claim number and restore to active status
- . D:RCEEOB>0 RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"R")
- ; END - PRCA*4.5*321
- ;
- D INIT^RCDPRPLM
- L -^RCY(344,RCRECTDA)
- Q
- ;
- ;
- CANCTRAN ; option: cancel a transaction
- ; this option can only be selected for unapproved receipts
- ; screen placed in protocol file and below as backup
- D FULL^VALM1
- S VALMBCK="R"
- ;
- N RCTRANDA
- ; select the payment transaction
- S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
- ;
- I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
- ;
- ; check to see if already cancelled
- I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4)=0,$P($G(^(1)),"^")'="" D Q
- . S VALMSG="Payment Transaction "_RCTRANDA_" is already CANCELLED."
- . D WRITE^RCDPRPLU(VALMSG)
- . L -^RCY(344,RCRECTDA)
- ;
- ; ask to cancel
- I $$ASKCANC(RCTRANDA)=1 D
- . D CANCTRAN^RCDPURET(RCRECTDA,RCTRANDA)
- . S VALMSG="Transaction # "_RCTRANDA_" has been CANCELLED"
- ;
- D INIT^RCDPRPLM
- L -^RCY(344,RCRECTDA)
- Q
- ;
- ;
- MOVETRAN ; move a transaction from one receipt to another
- D FULL^VALM1
- S VALMBCK="R"
- ;
- N RCNEWREC,RCNEWTRA,RCTRANDA
- ; select the payment transaction
- S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
- ;
- I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
- ;
- ; transaction is cancelled, cannot edit
- I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q
- . S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
- . D WRITE^RCDPRPLU(VALMSG)
- . D UNLOCK
- ;
- ; select the receipt to move transaction to (can add new one)
- F D Q:RCNEWREC
- . W !!,"Select the RECEIPT to move the payment transaction #"_RCTRANDA_" to:"
- . S RCNEWREC=$$SELRECT^RCDPUREC(1)
- . I RCNEWREC<1 S RCNEWREC=-1 Q
- . I RCNEWREC=RCRECTDA W !,"Cannot copy transaction to same receipt." S RCNEWREC=0 Q
- . I '$$CHECKREC^RCDPRPLU(RCNEWREC) W !,"Cannot copy to a receipt which is CLOSED." S RCNEWREC=0 Q
- I RCNEWREC<1 D UNLOCK Q
- ;
- I '$$LOCKREC^RCDPRPLU(RCNEWREC) D UNLOCK Q
- ;
- W !
- 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."
- ;
- I $$ASKMOVE(RCNEWREC)'=1 D UNLOCK Q
- ;
- ; MOVETRAN will add the new transaction, and allow the user to
- ; edit the data. returns error message if not successful or
- ; returns the transaction number.
- S RCNEWTRA=$$MOVETRAN^RCDPURET(RCRECTDA,RCTRANDA,RCNEWREC)
- I 'RCNEWTRA D Q
- . S VALMSG=%
- . D WRITE^RCDPRPLU(VALMSG)
- . D UNLOCK
- ;
- ; delete the transaction just moved
- D DELETRAN^RCDPURET(RCRECTDA,RCTRANDA)
- ;
- D INIT^RCDPRPLM
- S VALMSG="Transaction # "_RCTRANDA_" has been MOVED/DELETED."
- ;
- UNLOCK ; unlock receipts
- L -^RCY(344,RCRECTDA)
- I $G(RCNEWREC)>0 L -^RCY(344,RCNEWREC)
- Q
- ;
- ;
- SELPAY(RCRECTDA) ; select the payment transaction for the receipt (from listmanager options)
- N RCTRANDA
- ; if no payments, quit
- I '$O(^RCY(344,RCRECTDA,1,0)) S VALMSG="There are NO payments." Q 0
- ; if only one payment, select that one automatically
- I $P($G(^RCY(344,RCRECTDA,1,0)),"^",4)=1 S RCTRANDA=$O(^RCY(344,RCRECTDA,1,0))
- ; select the payment transaction
- I '$G(RCTRANDA) W ! S RCTRANDA=$$SELTRAN^RCDPURET(RCRECTDA)
- Q RCTRANDA
- ;
- ;
- ASKCANC(RCTRANDA) ; ask if it's okay to cancel a transaction
- ; 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 CANCEL transaction # "_RCTRANDA
- W ! D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1
- Q Y
- ;
- ;
- ASKMOVE(RECTDA) ; ask if its okay to move the transaction
- ; 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 MOVE this payment to receipt "_$P($G(^RCY(344,RECTDA,0)),"^")
- D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRPL1 5981 printed Feb 18, 2025@23:12:39 Page 2
- RCDPRPL1 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
- +1 ;;4.5;Accounts Receivable;**114,321**;Mar 20, 1995;Build 48
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ; this routine contains the entry points for payment transactions
- +6 ;
- +7 ;
- ENTRTRAN ; option: enter a payment transaction
- +1 ; this option can only be selected for unapproved receipts
- +2 ; screen placed in protocol file and below as backup
- +3 DO FULL^VALM1
- +4 SET VALMBCK="R"
- +5 ;
- +6 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
- QUIT
- +7 ;
- +8 NEW %,RCTRANDA,RCTYPE
- +9 SET RCTYPE=$PIECE($GET(^RC(341.1,+$PIECE(^RCY(344,RCRECTDA,0),"^",4),0)),"^",2)
- +10 ;
- +11 WRITE !
- +12 WRITE !," Type of payment: ",$PIECE($GET(^RC(341.1,+$PIECE(^RCY(344,RCRECTDA,0),"^",4),0)),"^")
- +13 WRITE !,"Adding a NEW payment transaction: "
- +14 SET RCTRANDA=$$ADDTRAN^RCDPURET(RCRECTDA)
- +15 IF 'RCTRANDA
- Begin DoDot:1
- +16 SET VALMSG="Unable to ADD a new payment transaction."
- +17 DO WRITE^RCDPRPLU(VALMSG)
- +18 LOCK -^RCY(344,RCRECTDA)
- End DoDot:1
- QUIT
- +19 ;
- +20 WRITE "# ",RCTRANDA
- +21 SET %=$$EDITTRAN^RCDPURET(RCRECTDA,RCTRANDA)
- +22 IF '%
- Begin DoDot:1
- +23 SET VALMSG=%
- +24 DO WRITE^RCDPRPLU(VALMSG)
- +25 LOCK -^RCY(344,RCRECTDA)
- End DoDot:1
- QUIT
- +26 ;
- +27 SET VALMSG="Transaction # "_RCTRANDA_" has been ADDED."
- +28 ;
- +29 DO INIT^RCDPRPLM
- +30 LOCK -^RCY(344,RCRECTDA)
- +31 QUIT
- +32 ;
- +33 ;
- EDITTRAN ; option: edit a payment transaction
- +1 ; this option can only be selected for unapproved receipts
- +2 ; screen placed in protocol file and below as backup
- +3 DO FULL^VALM1
- +4 SET VALMBCK="R"
- +5 ;
- +6 ; prca*4.5*321 - added RCEEOB
- NEW %,RCEEOB,RCTRANDA
- +7 ; select the payment transaction
- +8 SET RCTRANDA=$$SELPAY(RCRECTDA)
- IF RCTRANDA<1
- QUIT
- +9 ;
- +10 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
- QUIT
- +11 ;
- +12 ; transaction is cancelled, cannot edit
- +13 IF '$PIECE(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4)
- IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'=""
- Begin DoDot:1
- +14 SET VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
- +15 DO WRITE^RCDPRPLU(VALMSG)
- +16 LOCK -^RCY(344,RCRECTDA)
- End DoDot:1
- QUIT
- +17 ;
- +18 WRITE !!,"Editing Payment: ",RCTRANDA
- +19 SET %=$$EDITTRAN^RCDPURET(RCRECTDA,RCTRANDA)
- +20 IF '%
- SET VALMSG="Transaction DELETED."
- DO WRITE^RCDPRPLU(VALMSG)
- +21 ; BEGIN - PRCA*4.5*321
- +22 IF %
- Begin DoDot:1
- +23 ; Option to restore suspense EEOB
- +24 SET RCEEOB=$$EEOB^RCDPEM5(RCRECTDA,RCTRANDA)
- +25 ; Update EEOB claim number and restore to active status
- +26 if RCEEOB>0
- DO RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"R")
- End DoDot:1
- +27 ; END - PRCA*4.5*321
- +28 ;
- +29 DO INIT^RCDPRPLM
- +30 LOCK -^RCY(344,RCRECTDA)
- +31 QUIT
- +32 ;
- +33 ;
- CANCTRAN ; option: cancel a transaction
- +1 ; this option can only be selected for unapproved receipts
- +2 ; screen placed in protocol file and below as backup
- +3 DO FULL^VALM1
- +4 SET VALMBCK="R"
- +5 ;
- +6 NEW RCTRANDA
- +7 ; select the payment transaction
- +8 SET RCTRANDA=$$SELPAY(RCRECTDA)
- IF RCTRANDA<1
- QUIT
- +9 ;
- +10 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
- QUIT
- +11 ;
- +12 ; check to see if already cancelled
- +13 IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4)=0
- IF $PIECE($GET(^(1)),"^")'=""
- Begin DoDot:1
- +14 SET VALMSG="Payment Transaction "_RCTRANDA_" is already CANCELLED."
- +15 DO WRITE^RCDPRPLU(VALMSG)
- +16 LOCK -^RCY(344,RCRECTDA)
- End DoDot:1
- QUIT
- +17 ;
- +18 ; ask to cancel
- +19 IF $$ASKCANC(RCTRANDA)=1
- Begin DoDot:1
- +20 DO CANCTRAN^RCDPURET(RCRECTDA,RCTRANDA)
- +21 SET VALMSG="Transaction # "_RCTRANDA_" has been CANCELLED"
- End DoDot:1
- +22 ;
- +23 DO INIT^RCDPRPLM
- +24 LOCK -^RCY(344,RCRECTDA)
- +25 QUIT
- +26 ;
- +27 ;
- MOVETRAN ; move a transaction from one receipt to another
- +1 DO FULL^VALM1
- +2 SET VALMBCK="R"
- +3 ;
- +4 NEW RCNEWREC,RCNEWTRA,RCTRANDA
- +5 ; select the payment transaction
- +6 SET RCTRANDA=$$SELPAY(RCRECTDA)
- IF RCTRANDA<1
- QUIT
- +7 ;
- +8 IF '$$LOCKREC^RCDPRPLU(RCRECTDA)
- QUIT
- +9 ;
- +10 ; transaction is cancelled, cannot edit
- +11 IF '$PIECE(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4)
- IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'=""
- Begin DoDot:1
- +12 SET VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
- +13 DO WRITE^RCDPRPLU(VALMSG)
- +14 DO UNLOCK
- End DoDot:1
- QUIT
- +15 ;
- +16 ; select the receipt to move transaction to (can add new one)
- +17 FOR
- Begin DoDot:1
- +18 WRITE !!,"Select the RECEIPT to move the payment transaction #"_RCTRANDA_" to:"
- +19 SET RCNEWREC=$$SELRECT^RCDPUREC(1)
- +20 IF RCNEWREC<1
- SET RCNEWREC=-1
- QUIT
- +21 IF RCNEWREC=RCRECTDA
- WRITE !,"Cannot copy transaction to same receipt."
- SET RCNEWREC=0
- QUIT
- +22 IF '$$CHECKREC^RCDPRPLU(RCNEWREC)
- WRITE !,"Cannot copy to a receipt which is CLOSED."
- SET RCNEWREC=0
- QUIT
- End DoDot:1
- if RCNEWREC
- QUIT
- +23 IF RCNEWREC<1
- DO UNLOCK
- QUIT
- +24 ;
- +25 IF '$$LOCKREC^RCDPRPLU(RCNEWREC)
- DO UNLOCK
- QUIT
- +26 ;
- +27 WRITE !
- +28 IF $PIECE($GET(^RCY(344,RCNEWREC,0)),"^",4)'=$PIECE(^RCY(344,RCRECTDA,0),"^",4)
- WRITE !,"WARNING, receipt types of payment are not the same type of payment."
- +29 ;
- +30 IF $$ASKMOVE(RCNEWREC)'=1
- DO UNLOCK
- QUIT
- +31 ;
- +32 ; MOVETRAN will add the new transaction, and allow the user to
- +33 ; edit the data. returns error message if not successful or
- +34 ; returns the transaction number.
- +35 SET RCNEWTRA=$$MOVETRAN^RCDPURET(RCRECTDA,RCTRANDA,RCNEWREC)
- +36 IF 'RCNEWTRA
- Begin DoDot:1
- +37 SET VALMSG=%
- +38 DO WRITE^RCDPRPLU(VALMSG)
- +39 DO UNLOCK
- End DoDot:1
- QUIT
- +40 ;
- +41 ; delete the transaction just moved
- +42 DO DELETRAN^RCDPURET(RCRECTDA,RCTRANDA)
- +43 ;
- +44 DO INIT^RCDPRPLM
- +45 SET VALMSG="Transaction # "_RCTRANDA_" has been MOVED/DELETED."
- +46 ;
- UNLOCK ; unlock receipts
- +1 LOCK -^RCY(344,RCRECTDA)
- +2 IF $GET(RCNEWREC)>0
- LOCK -^RCY(344,RCNEWREC)
- +3 QUIT
- +4 ;
- +5 ;
- SELPAY(RCRECTDA) ; select the payment transaction for the receipt (from listmanager options)
- +1 NEW RCTRANDA
- +2 ; if no payments, quit
- +3 IF '$ORDER(^RCY(344,RCRECTDA,1,0))
- SET VALMSG="There are NO payments."
- QUIT 0
- +4 ; if only one payment, select that one automatically
- +5 IF $PIECE($GET(^RCY(344,RCRECTDA,1,0)),"^",4)=1
- SET RCTRANDA=$ORDER(^RCY(344,RCRECTDA,1,0))
- +6 ; select the payment transaction
- +7 IF '$GET(RCTRANDA)
- WRITE !
- SET RCTRANDA=$$SELTRAN^RCDPURET(RCRECTDA)
- +8 QUIT RCTRANDA
- +9 ;
- +10 ;
- ASKCANC(RCTRANDA) ; ask if it's okay to cancel a transaction
- +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 CANCEL transaction # "_RCTRANDA
- +5 WRITE !
- DO ^DIR
- +6 IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- +7 QUIT Y
- +8 ;
- +9 ;
- ASKMOVE(RECTDA) ; ask if its okay to move the transaction
- +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 MOVE this payment to receipt "_$PIECE($GET(^RCY(344,RECTDA,0)),"^")
- +5 DO ^DIR
- +6 IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- +7 QUIT Y