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

RCDPLPL1.m

Go to the documentation of this file. 
  1. RCDPLPL1 ;WISC/RFJ/PJH - link payments listmanager options ;5/25/11 2:53pm
  1.  ;;4.5;Accounts Receivable;**114,148,153,208,269,304,321**;Mar 20, 1995;Build 48
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ;
  1. CHKTRACE ;EP Protocol action - RCDP LINK PAYMENTS SEARCH CHECK
  1.  ; Ask to search by check # or trace #
  1.  N DIR,X,Y
  1.  D FULL^VALM1
  1.  S DIR("A")="SEARCH BY (C)HECK OR (T)RACE #?: "
  1.  S DIR(0)="SA^C:CHECK;T:TRACE",DIR("B")="CHECK"
  1.  W ! D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)
  1.  I Y="C" D  Q
  1.  . D FINDCHEK
  1.  I Y="T" D  Q
  1.  . D FINDTRAC
  1.  Q
  1.  ;
  1. FINDCHEK ; Find a specific check used for payments
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  ;
  1.  N RCCHECK,RCTYPE
  1.  K RCFCHECK,RCFCREDT,RCFTRACE
  1.  W !
  1.  S RCCHECK=$$ASKCHEK I RCCHECK=-1 D INIT^RCDPLPLM Q
  1.  ;
  1.  S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
  1.  S RCFCHECK=RCCHECK_"^"_RCTYPE
  1.  D INIT^RCDPLPLM
  1.  Q
  1.  ;
  1. FINDTRAC ; Find a specific trace # used for EFT/ERA payments
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  ;
  1.  N RCTRACE,RCTYPE
  1.  K RCFTRACE,RCFCREDT,RCFCHECK
  1.  W !
  1.  S RCTRACE=$$ASKTRACE I RCTRACE=-1 D INIT^RCDPLPLM Q
  1.  ;
  1.  S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
  1.  S RCFTRACE=RCTRACE_"^"_RCTYPE
  1.  D INIT^RCDPLPLM
  1.  Q
  1.  ;
  1.  ;
  1. FINDCRED ;EP Protocol Action -  RCDP LINK PAYMENTS SEARCH CREDIT
  1.  ; Find a specific credit card used for payments
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  ;
  1.  N RCCREDT,RCTYPE
  1.  K RCFCHECK,RCFCREDT,RCFTRACE
  1.  W !
  1.  S RCCREDT=$$ASKCRED I RCCREDT=-1 D INIT^RCDPLPLM Q
  1.  ;
  1.  S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
  1.  S RCFCREDT=RCCREDT_"^"_RCTYPE
  1.  D INIT^RCDPLPLM
  1.  Q
  1.  ;
  1.  ;
  1. ACCOUNT ;EP Protocol Action - RCDP LINK PAYMENTS ACCOUNT PROFILE
  1.  ; Account profile
  1.  D FULL^VALM1
  1.  D ACCTPROF^RCDPAPLM
  1.  D INIT^RCDPLPLM
  1.  S VALMBCK="R"
  1.  ;  fast exit
  1.  I $G(RCDPFXIT) S VALMBCK="Q"
  1.  Q
  1.  ;
  1.  ;
  1. RECEIPT ;EP Protocol Action - RCDP LINK PAYMENTS RECEIPT PROFILE
  1.  ; Receipt profile
  1.  D FULL^VALM1
  1.  D RECTPROF^RCDPRPLM
  1.  D INIT^RCDPLPLM
  1.  S VALMBCK="R"
  1.  I $G(RCDPFXIT) S VALMBCK="Q"
  1.  Q
  1.  ;
  1. CLEARSUS ;EP Protocol action - RCDP LINK PAYMENTS CLEAR SUSPENSE
  1.  ; Flag a payment as being cleared from suspense
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  ;
  1.  W !!,"This option will allow you to enter the FMS Document Number used"
  1.  W !,"to clear the payment from the suspense account in FMS.  Once an"
  1.  W !,"FMS Document Number is entered, the payment will no longer appear"
  1.  W !,"on the list as Unlinked.",!
  1.  N INDEX,RCPAY,RCRECTDA,RCTRANDA
  1.  S INDEX=$$SELPAY
  1.  I INDEX D
  1.  .   S RCPAY=$G(^TMP("RCDPLPLM",$J,"IDX",INDEX,INDEX))
  1.  .   S RCRECTDA=+$P(RCPAY,"^"),RCTRANDA=+$P(RCPAY,"^",2)
  1.  I 'INDEX D
  1.  .   W ! S RCRECTDA=+$$SELRECT^RCDPUREC(0,0) I RCRECTDA<1 Q
  1.  .   S RCTRANDA=+$$SELTRAN^RCDPURET(RCRECTDA) I RCTRANDA<1 S RCTRANDA=0
  1.  I '$G(RCRECTDA)!('$G(RCTRANDA)) S VALMBCK="R" Q
  1.  ;
  1.  W !!,"                   Receipt: ",$P(^RCY(344,RCRECTDA,0),"^")
  1.  W !,"               Transaction: ",RCTRANDA
  1.  W !,"  Unapplied Deposit Number: ",$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)
  1.  D EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"")
  1.  ;
  1.  ;PRCA*4.5*304 Force a comment and update audit Log
  1.  ;ask for comment
  1.  D ADDCMT(RCRECTDA,RCTRANDA)
  1.  ;
  1.  ;If the CR document was filed, update the Audit Log and suspense status
  1.  I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),U,6)'="" D
  1.  . D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"R")
  1.  . D SUSPDIS^RCBEPAY(RCRECTDA,RCTRANDA,"R")
  1.  ;end PRCA*4.5*304
  1.  ;
  1.  S VALMBCK="R"
  1.  D INIT^RCDPLPLM
  1.  Q
  1.  ;
  1. SELPAY() ; Select a payment from the form list
  1.  N VALMBG,VALMLST
  1.  ;  if no payments, quit
  1.  I '$O(^TMP("RCDPLPLM",$J,"IDX",0)) S VALMSG="There are NO payments on the form to select." Q 0
  1.  ;
  1.  ;  if only one payment, select that one automatically
  1.  I '$O(^TMP("RCDPLPLM",$J,"IDX",1)) Q 1
  1.  ;
  1.  ;  select the entry from the list
  1.  ;  if not on first screen, make sure selection begins with 1
  1.  S VALMBG=1
  1.  ;  if not on last screen, make sure selection ends with last
  1.  S VALMLST=$O(^TMP("RCDPLPLM",$J,"IDX",999999999),-1)
  1.  D EN^VALM2($G(XQORNOD(0)),"OS")
  1.  Q $O(VALMY(0))
  1.  ;
  1. ASKCHEK() ; Ask the check number
  1.  N DIR,X,Y
  1.  S DIR(0)="FAO^1:50"
  1.  S DIR("A")="Enter the Check Number to Search for: "
  1.  S DIR("?")="Enter the check number from 1 to 50 characters free text."
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1.  Q $S(Y'="":Y,1:-1)
  1.  ;
  1. ASKTRACE() ; Ask the e-payments trace number
  1.  N DIR,X,Y
  1.  S DIR(0)="FAO^1:50"
  1.  S DIR("A")="Enter the e-Payments Trace Number to Search for: "
  1.  S DIR("?")="Enter the trace number from 1 to 50 characters free text."
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1.  Q $S(Y'="":Y,1:-1)
  1.  ;
  1. ASKCRED() ; Ask the credit card number
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="NAO^0:9999999999999999"
  1.  S DIR("A")="Enter the Credit Card Number to Search for: "
  1.  S DIR("?")="Enter the check card number from 1 to 16 numbers."
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1.  Q $S(Y'="":Y,1:-1)
  1.  ;
  1. ASKTYPE() ; Ask the type of match
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="SAO^1:Exact Match;2:Contains;"
  1.  S DIR("A")="Type of Match: "
  1.  S DIR("B")="Contains"
  1.  D ^DIR
  1.  I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1.  Q $S(Y=1:"EQUAL TO",Y=2:"CONTAINING",1:-1)
  1.  ;
  1.  ;PRCA*4.5*304
  1. ADDCMT(RCRECTDA,RCTRANDA)   ; Ask for a comment for the suspense entry
  1.  ;
  1.  N DA,DIDEL,DIE,DIR,DIRUT,DIROUT,DR,DTOUT,DUOUT,RCDCMT,X,Y
  1.  S RCDCMT=""
  1.  F  D  Q:RCDCMT'=""
  1.  . S Y=$$COM^RCDPECH ; PRCA*4.5*321
  1.  . ;strip all leading and trailing spaces
  1.  . S Y=$$TRIM^XLFSTR(Y)
  1.  . I (Y="")!(Y=-1) D  Q
  1.  . . W !,"A comment is required when changing the status of an item in Suspense.  Please try again."
  1.  . S RCDCMT=Y
  1.  ;
  1.  ; Update the comment field
  1.  S DR="1.02////"_RCDCMT
  1.  S DIE="^RCY(344,"_RCRECTDA_",1,"
  1.  S DA=RCTRANDA,DA(1)=RCRECTDA
  1.  D ^DIE
  1.  D LASTEDIT^RCDPUREC(RCRECTDA)
  1.  ;Update comment history - PRCA*4.5*321
  1.  D AUDIT^RCDPECH(RCRECTDA,RCTRANDA,"","")
  1.  Q