151 lines
6.4 KiB
Mathematica
151 lines
6.4 KiB
Mathematica
RCDPLPLM ;WISC/RFJ-link payments listmanager top routine ;1 Jun 99
|
|
;;4.5;Accounts Receivable;**114,208**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
N RCFCHECK,RCFTRACE,RCFCREDT,RCDPFXIT
|
|
N %,%DT,%H,%I,RCDPPADT,X,Y
|
|
S %DT("A")="Start with Payment Date (press RETURN for FIRST): ",%DT="AEP",%DT(0)=-DT
|
|
D ^%DT I Y<0,X["^" Q
|
|
; if user entered a date, go back one day
|
|
I Y'<0 S RCDPPADT=$$FMADD^XLFDT(+Y,-1)
|
|
;
|
|
D EN^VALM("RCDP LINK PAYMENTS TO ACCOUNTS")
|
|
Q
|
|
;
|
|
INIT ; initialization for list manager list
|
|
; pass RCDPPADT to display payments after RCDPPADT date
|
|
; pass RCFCHECK, RCFTRACE and RCFCREDT to search by
|
|
; check/trace #/credit card #
|
|
; fast exit
|
|
I $G(RCDPFXIT) S VALMQUIT=1 Q
|
|
;
|
|
W !!,"please wait, building list of unlinked payments..."
|
|
;
|
|
N DATE,FMSDOC,NUMBER,RCCOUNT,RCDATA,RCLINE,RCRECTDA,RCTOTAL,RCTRANDA,RECDATA,TYPE
|
|
;
|
|
; set the listmanager line number
|
|
S RCLINE=0
|
|
; set the lookup payment number from list
|
|
S RCCOUNT=0
|
|
; get list of unlinked accounts
|
|
K ^TMP("RCDPLPLM",$J)
|
|
S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AN",RCRECTDA)) Q:'RCRECTDA D
|
|
. S RECDATA=$G(^RCY(344,RCRECTDA,0))
|
|
. S RCTRANDA=0 F S RCTRANDA=$O(^RCY(344,"AN",RCRECTDA,RCTRANDA)) Q:'RCTRANDA D
|
|
. . S RCDATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
|
|
. . I '$P(RCDATA,"^",4) Q ;no payment amount
|
|
. . ; fms doc id entered (field 26) to clear suspense
|
|
. . I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",6)'="" Q
|
|
. . ; unlinked
|
|
. . ; get payment date
|
|
. . S DATE=$P(RCDATA,"^",6)
|
|
. . I 'DATE S DATE=$P(RCDATA,"^",10)
|
|
. . I 'DATE S DATE=$P(RECDATA,"^",3)
|
|
. . I 'DATE S DATE=0
|
|
. . ; before selected payment date
|
|
. . I $G(RCDPPADT),DATE<RCDPPADT Q
|
|
. . ;
|
|
. . S RCLINE=RCLINE+1
|
|
. . S RCCOUNT=RCCOUNT+1
|
|
. . ;
|
|
. . ; create an index array for bill lookup in list
|
|
. . S ^TMP("RCDPLPLM",$J,"IDX",RCCOUNT,RCCOUNT)=RCRECTDA_"^"_RCTRANDA
|
|
. . ;
|
|
. . D SET(RCCOUNT,RCLINE,1,80)
|
|
. . ; receipt number
|
|
. . D SET($P(RECDATA,"^"),RCLINE,6,18)
|
|
. . ; transaction number
|
|
. . D SET($J(RCTRANDA,5),RCLINE,18,24)
|
|
. . ; unapplied deposit number
|
|
. . D SET($J($$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRANDA,0),13),RCLINE,26,39)
|
|
. . ; receipt status
|
|
. . D SET($E($S($P(RECDATA,"^",14):"OPEN",1:"CLOSED"),1,4),RCLINE,41,44)
|
|
. . ; payment date
|
|
. . D SET($E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),RCLINE,47,54)
|
|
. . ; get type of payment
|
|
. . S TYPE=$S($P(RECDATA,U,18)&$P(RECDATA,U,17):"TRACE",1:"") ;EFT/ERA payment
|
|
. . I TYPE="" D
|
|
. . . S TYPE=$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",4)
|
|
. . . S TYPE=$S(TYPE=1:"CASH",TYPE=2:"CHECK",TYPE=3:"CREDIT",1:"")
|
|
. . I TYPE="" S TYPE=$P($G(^RC(341.1,+$P(RECDATA,"^",4),0)),"^")
|
|
. . D SET(TYPE,RCLINE,57,60)
|
|
. . ; get check, trace, credit #, RCFCHECK RCFTRACE and RCFCREDT
|
|
. . ; can be used to match a specific check, trace or credit card #
|
|
. . ; the variable is in the form:
|
|
. . ; RCFCHECK=number^EXACT or number^CONTAINS
|
|
. . I $G(RCFCHECK)'="",$E(TYPE,1,5)'="CHECK" Q
|
|
. . I $G(RCFTRACE)'="",$E(TYPE,1,5)'="TRACE" Q
|
|
. . I $G(RCFCREDT)'="",$E(TYPE,1,6)'="CREDIT" Q
|
|
. . S NUMBER=""
|
|
. . I $E(TYPE,1,5)="CHECK" D Q:NUMBER=""
|
|
. . . S NUMBER=$P(RCDATA,"^",7)
|
|
. . . I $G(RCFCHECK)'="",NUMBER="" Q
|
|
. . . I $E($P($G(RCFCHECK),"^",2))="E",NUMBER'=$P(RCFCHECK,"^") S NUMBER="" Q
|
|
. . . I $E($P($G(RCFCHECK),"^",2))="C",NUMBER'[$P(RCFCHECK,"^") S NUMBER="" Q
|
|
. . . I NUMBER="" S NUMBER=" "
|
|
. . I $E(TYPE,1,5)="TRACE" D Q:NUMBER=""
|
|
. . . S NUMBER=$P($G(^RCY(344.4,+$P(RECDATA,U,18),0)),U,2)
|
|
. . . I $G(RCFTRACE)'="",NUMBER="" Q
|
|
. . . I $E($P($G(RCFTRACE),"^",2))="E",NUMBER'=$P(RCFTRACE,"^") S NUMBER="" Q
|
|
. . . I $E($P($G(RCFTRACE),"^",2))="C",NUMBER'[$P(RCFTRACE,"^") S NUMBER="" Q
|
|
. . . I NUMBER="" S NUMBER=" "
|
|
. . I $E(TYPE,1,6)="CREDIT" D Q:NUMBER=""
|
|
. . . S NUMBER=$P(RCDATA,"^",11)
|
|
. . . I $G(RCFCHECK)'="",NUMBER="" Q
|
|
. . . I $E($P($G(RCFCREDT),"^",2))="E",NUMBER'=$P(RCFCREDT,"^") S NUMBER="" Q
|
|
. . . I $E($P($G(RCFCREDT),"^",2))="C",NUMBER'[$P(RCFCREDT,"^") S NUMBER="" Q
|
|
. . . I NUMBER="" S NUMBER=" "
|
|
. . I NUMBER="" S NUMBER=" "
|
|
. . S %=$L(NUMBER) I %>8 S NUMBER=$E(NUMBER,%-7,%)
|
|
. . ; check/trace/credit# (last 8 chars)
|
|
. . D SET(NUMBER,RCLINE,62,69)
|
|
. . ; amount paid
|
|
. . D SET($J($P(RCDATA,"^",4),10,2),RCLINE,70,80)
|
|
. . ; since list manager adds spaces to line, make sure line is
|
|
. . ; 80 characters so the print list looks okay
|
|
. . S ^TMP("RCDPLPLM",$J,RCLINE,0)=$E(^TMP("RCDPLPLM",$J,RCLINE,0),1,80)
|
|
. . S RCTOTAL=$G(RCTOTAL)+$P(RCDATA,"^",4)
|
|
. . ;
|
|
. . ; show line 2
|
|
. . ; account lookup
|
|
. . S RCLINE=RCLINE+1
|
|
. . S %=$E("AcctLU: "_$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^")_" ",1,24)
|
|
. . D SET(" "_%,RCLINE,1,80)
|
|
. . ; fms cr document
|
|
. . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
|
|
. . D SET($E("CRdoc: "_$P(FMSDOC,"^")_" ",1,22),RCLINE,41,80)
|
|
. . ; cr document status
|
|
. . D SET($P(FMSDOC,"^",2),RCLINE,63,68)
|
|
. . ; make second line longer than 80 characters for printing
|
|
. . ; this will add an extra line after each entry
|
|
. . D SET(" ",RCLINE,80,84)
|
|
;
|
|
S RCLINE=RCLINE+1 D SET("----------",RCLINE,70,80)
|
|
S RCLINE=RCLINE+1 D SET("TOTAL: "_$J($G(RCTOTAL),10,2),RCLINE,63,80)
|
|
;
|
|
; set valmcnt to number of lines in the list
|
|
S VALMCNT=RCLINE
|
|
D HDR
|
|
Q
|
|
;
|
|
;
|
|
SET(STRING,LINE,COLBEG,COLEND) ; set array
|
|
I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
|
|
D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
|
|
Q
|
|
;
|
|
;
|
|
HDR ; header code for list manager display
|
|
S VALMHDR(1)="Transactions for ALL Unapplied Payments"
|
|
I $G(RCDPPADT)>0 S Y=RCDPPADT D DD^%DT S VALMHDR(1)="Transactions for Unapplied Payments After "_Y
|
|
S VALMHDR(2)=" "
|
|
I $G(RCFCHECK)'="" S VALMHDR(2)=" List of Payments With Check Numbers "_$P(RCFCHECK,"^",2)_" "_$P(RCFCHECK,"^")
|
|
I $G(RCFTRACE)'="" S VALMHDR(2)=" List of Payments With Trace Numbers "_$P(RCFTRACE,"^",2)_" "_$P(RCFTRACE,"^")
|
|
I $G(RCFCREDT)'="" S VALMHDR(2)=" List of Payments With Credit Cards "_$P(RCFCREDT,"^",2)_" "_$P(RCFCREDT,"^")
|
|
Q
|
|
;
|
|
;
|
|
EXIT ; exit list manager option and clean up
|
|
K ^TMP("RCDPLPLM",$J),^TMP("RCDPLPLMUNLINK",$J)
|
|
Q
|