- RCDPDPLU ;WISC/RFJ-deposit profile utilities ;1 Jun 99
- ;;4.5;Accounts Receivable;**114,173**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- CHECKDEP(DEPTDA) ; check the deposit to stop edit/change if approved
- ; return 0^message to stop edit/change
- ; 1 to continue
- N MESSAGE,RECTDA,RESULT
- ;
- ; already confirmed, status = 3 confirmed
- I $P($G(^RCY(344.1,DEPTDA,0)),"^",12)=3 Q "0^Deposit has been confirmed."
- ; lockbox
- S RECTDA=$O(^RCY(344,"AD",$P(^RCY(344.1,DEPTDA,0),"^"),0))
- I RECTDA,$P($G(^RC(341.1,+$P($G(^RCY(344,RECTDA,0)),"^",4),0)),"^",2)=12 Q "0^Lockbox type deposit."
- I RECTDA,$$EDILB^RCDPEU(RECTDA)=1 Q "0^EDI Lockbox type deposit."
- ; open
- Q 1
- ;
- ;
- LOCKDEP(DEPTDA) ; lock the deposit, call only from listmanager options
- ; if deposit not passed, return 2
- I 'DEPTDA Q 2
- N RESULT
- S RESULT=1
- L +^RCY(344.1,DEPTDA):5
- I '$T D
- . S VALMSG="Another user is editing the deposit."
- . D WRITE^RCDPRPLU(VALMSG)
- . S RESULT=0
- Q RESULT
- ;
- ;
- MAILMSG(RCDEPTDA,ACTION) ; mail a message to supervisor key holders
- N %,LINE,VALMHDR,VALMSG,XMDUZ,XMZ,YY
- K ^TMP($J,"RCDPDPLU")
- S LINE=0
- ;
- ; ---- start build mailman message ----
- D SETLINE("Sent to: PRCAY PAYMENT SUP security key holders")
- D SETLINE(" ")
- ;
- ; build the header line
- D HDR^RCDPDPLM
- F %=1:1 Q:'$D(VALMHDR(%)) D SETLINE(VALMHDR(%))
- ;
- D SETLINE(" ")
- D SETLINE("This deposit was confirmed and the following action occurred:")
- D SETLINE(" ACTION: "_ACTION)
- D SETLINE(" BY: "_$P(^VA(200,DUZ,0),"^"))
- ; ---- end build mailman message ----
- ;
- S XMSUB="Deposit Processing Audit"
- S XMDUZ="Accounts Receivable Package"
- S XMTEXT="^TMP($J,""RCDPDPLU"","
- S %=0 F S %=$O(^XUSEC("PRCAY PAYMENT SUP",%)) Q:'% S XMY(%)=""
- D ^XMD
- K ^TMP($J,"RCDPDPLU")
- Q
- ;
- ;
- SETLINE(MESSAGE) ; set the line for the mail message
- S LINE=LINE+1
- S ^TMP($J,"RCDPDPLU",LINE)=MESSAGE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPDPLU 1996 printed Jan 18, 2025@02:45:16 Page 2
- RCDPDPLU ;WISC/RFJ-deposit profile utilities ;1 Jun 99
- +1 ;;4.5;Accounts Receivable;**114,173**;Mar 20, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- CHECKDEP(DEPTDA) ; check the deposit to stop edit/change if approved
- +1 ; return 0^message to stop edit/change
- +2 ; 1 to continue
- +3 NEW MESSAGE,RECTDA,RESULT
- +4 ;
- +5 ; already confirmed, status = 3 confirmed
- +6 IF $PIECE($GET(^RCY(344.1,DEPTDA,0)),"^",12)=3
- QUIT "0^Deposit has been confirmed."
- +7 ; lockbox
- +8 SET RECTDA=$ORDER(^RCY(344,"AD",$PIECE(^RCY(344.1,DEPTDA,0),"^"),0))
- +9 IF RECTDA
- IF $PIECE($GET(^RC(341.1,+$PIECE($GET(^RCY(344,RECTDA,0)),"^",4),0)),"^",2)=12
- QUIT "0^Lockbox type deposit."
- +10 IF RECTDA
- IF $$EDILB^RCDPEU(RECTDA)=1
- QUIT "0^EDI Lockbox type deposit."
- +11 ; open
- +12 QUIT 1
- +13 ;
- +14 ;
- LOCKDEP(DEPTDA) ; lock the deposit, call only from listmanager options
- +1 ; if deposit not passed, return 2
- +2 IF 'DEPTDA
- QUIT 2
- +3 NEW RESULT
- +4 SET RESULT=1
- +5 LOCK +^RCY(344.1,DEPTDA):5
- +6 IF '$TEST
- Begin DoDot:1
- +7 SET VALMSG="Another user is editing the deposit."
- +8 DO WRITE^RCDPRPLU(VALMSG)
- +9 SET RESULT=0
- End DoDot:1
- +10 QUIT RESULT
- +11 ;
- +12 ;
- MAILMSG(RCDEPTDA,ACTION) ; mail a message to supervisor key holders
- +1 NEW %,LINE,VALMHDR,VALMSG,XMDUZ,XMZ,YY
- +2 KILL ^TMP($JOB,"RCDPDPLU")
- +3 SET LINE=0
- +4 ;
- +5 ; ---- start build mailman message ----
- +6 DO SETLINE("Sent to: PRCAY PAYMENT SUP security key holders")
- +7 DO SETLINE(" ")
- +8 ;
- +9 ; build the header line
- +10 DO HDR^RCDPDPLM
- +11 FOR %=1:1
- if '$DATA(VALMHDR(%))
- QUIT
- DO SETLINE(VALMHDR(%))
- +12 ;
- +13 DO SETLINE(" ")
- +14 DO SETLINE("This deposit was confirmed and the following action occurred:")
- +15 DO SETLINE(" ACTION: "_ACTION)
- +16 DO SETLINE(" BY: "_$PIECE(^VA(200,DUZ,0),"^"))
- +17 ; ---- end build mailman message ----
- +18 ;
- +19 SET XMSUB="Deposit Processing Audit"
- +20 SET XMDUZ="Accounts Receivable Package"
- +21 SET XMTEXT="^TMP($J,""RCDPDPLU"","
- +22 SET %=0
- FOR
- SET %=$ORDER(^XUSEC("PRCAY PAYMENT SUP",%))
- if '%
- QUIT
- SET XMY(%)=""
- +23 DO ^XMD
- +24 KILL ^TMP($JOB,"RCDPDPLU")
- +25 QUIT
- +26 ;
- +27 ;
- SETLINE(MESSAGE) ; set the line for the mail message
- +1 SET LINE=LINE+1
- +2 SET ^TMP($JOB,"RCDPDPLU",LINE)=MESSAGE
- +3 QUIT