| [613] | 1 | RCDPLPLM ;WISC/RFJ-link payments listmanager top routine ;1 Jun 99
|
|---|
| 2 | ;;4.5;Accounts Receivable;**114,208**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | N RCFCHECK,RCFTRACE,RCFCREDT,RCDPFXIT
|
|---|
| 6 | N %,%DT,%H,%I,RCDPPADT,X,Y
|
|---|
| 7 | S %DT("A")="Start with Payment Date (press RETURN for FIRST): ",%DT="AEP",%DT(0)=-DT
|
|---|
| 8 | D ^%DT I Y<0,X["^" Q
|
|---|
| 9 | ; if user entered a date, go back one day
|
|---|
| 10 | I Y'<0 S RCDPPADT=$$FMADD^XLFDT(+Y,-1)
|
|---|
| 11 | ;
|
|---|
| 12 | D EN^VALM("RCDP LINK PAYMENTS TO ACCOUNTS")
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | INIT ; initialization for list manager list
|
|---|
| 16 | ; pass RCDPPADT to display payments after RCDPPADT date
|
|---|
| 17 | ; pass RCFCHECK, RCFTRACE and RCFCREDT to search by
|
|---|
| 18 | ; check/trace #/credit card #
|
|---|
| 19 | ; fast exit
|
|---|
| 20 | I $G(RCDPFXIT) S VALMQUIT=1 Q
|
|---|
| 21 | ;
|
|---|
| 22 | W !!,"please wait, building list of unlinked payments..."
|
|---|
| 23 | ;
|
|---|
| 24 | N DATE,FMSDOC,NUMBER,RCCOUNT,RCDATA,RCLINE,RCRECTDA,RCTOTAL,RCTRANDA,RECDATA,TYPE
|
|---|
| 25 | ;
|
|---|
| 26 | ; set the listmanager line number
|
|---|
| 27 | S RCLINE=0
|
|---|
| 28 | ; set the lookup payment number from list
|
|---|
| 29 | S RCCOUNT=0
|
|---|
| 30 | ; get list of unlinked accounts
|
|---|
| 31 | K ^TMP("RCDPLPLM",$J)
|
|---|
| 32 | S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AN",RCRECTDA)) Q:'RCRECTDA D
|
|---|
| 33 | . S RECDATA=$G(^RCY(344,RCRECTDA,0))
|
|---|
| 34 | . S RCTRANDA=0 F S RCTRANDA=$O(^RCY(344,"AN",RCRECTDA,RCTRANDA)) Q:'RCTRANDA D
|
|---|
| 35 | . . S RCDATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
|
|---|
| 36 | . . I '$P(RCDATA,"^",4) Q ;no payment amount
|
|---|
| 37 | . . ; fms doc id entered (field 26) to clear suspense
|
|---|
| 38 | . . I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",6)'="" Q
|
|---|
| 39 | . . ; unlinked
|
|---|
| 40 | . . ; get payment date
|
|---|
| 41 | . . S DATE=$P(RCDATA,"^",6)
|
|---|
| 42 | . . I 'DATE S DATE=$P(RCDATA,"^",10)
|
|---|
| 43 | . . I 'DATE S DATE=$P(RECDATA,"^",3)
|
|---|
| 44 | . . I 'DATE S DATE=0
|
|---|
| 45 | . . ; before selected payment date
|
|---|
| 46 | . . I $G(RCDPPADT),DATE<RCDPPADT Q
|
|---|
| 47 | . . ;
|
|---|
| 48 | . . S RCLINE=RCLINE+1
|
|---|
| 49 | . . S RCCOUNT=RCCOUNT+1
|
|---|
| 50 | . . ;
|
|---|
| 51 | . . ; create an index array for bill lookup in list
|
|---|
| 52 | . . S ^TMP("RCDPLPLM",$J,"IDX",RCCOUNT,RCCOUNT)=RCRECTDA_"^"_RCTRANDA
|
|---|
| 53 | . . ;
|
|---|
| 54 | . . D SET(RCCOUNT,RCLINE,1,80)
|
|---|
| 55 | . . ; receipt number
|
|---|
| 56 | . . D SET($P(RECDATA,"^"),RCLINE,6,18)
|
|---|
| 57 | . . ; transaction number
|
|---|
| 58 | . . D SET($J(RCTRANDA,5),RCLINE,18,24)
|
|---|
| 59 | . . ; unapplied deposit number
|
|---|
| 60 | . . D SET($J($$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRANDA,0),13),RCLINE,26,39)
|
|---|
| 61 | . . ; receipt status
|
|---|
| 62 | . . D SET($E($S($P(RECDATA,"^",14):"OPEN",1:"CLOSED"),1,4),RCLINE,41,44)
|
|---|
| 63 | . . ; payment date
|
|---|
| 64 | . . D SET($E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),RCLINE,47,54)
|
|---|
| 65 | . . ; get type of payment
|
|---|
| 66 | . . S TYPE=$S($P(RECDATA,U,18)&$P(RECDATA,U,17):"TRACE",1:"") ;EFT/ERA payment
|
|---|
| 67 | . . I TYPE="" D
|
|---|
| 68 | . . . S TYPE=$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",4)
|
|---|
| 69 | . . . S TYPE=$S(TYPE=1:"CASH",TYPE=2:"CHECK",TYPE=3:"CREDIT",1:"")
|
|---|
| 70 | . . I TYPE="" S TYPE=$P($G(^RC(341.1,+$P(RECDATA,"^",4),0)),"^")
|
|---|
| 71 | . . D SET(TYPE,RCLINE,57,60)
|
|---|
| 72 | . . ; get check, trace, credit #, RCFCHECK RCFTRACE and RCFCREDT
|
|---|
| 73 | . . ; can be used to match a specific check, trace or credit card #
|
|---|
| 74 | . . ; the variable is in the form:
|
|---|
| 75 | . . ; RCFCHECK=number^EXACT or number^CONTAINS
|
|---|
| 76 | . . I $G(RCFCHECK)'="",$E(TYPE,1,5)'="CHECK" Q
|
|---|
| 77 | . . I $G(RCFTRACE)'="",$E(TYPE,1,5)'="TRACE" Q
|
|---|
| 78 | . . I $G(RCFCREDT)'="",$E(TYPE,1,6)'="CREDIT" Q
|
|---|
| 79 | . . S NUMBER=""
|
|---|
| 80 | . . I $E(TYPE,1,5)="CHECK" D Q:NUMBER=""
|
|---|
| 81 | . . . S NUMBER=$P(RCDATA,"^",7)
|
|---|
| 82 | . . . I $G(RCFCHECK)'="",NUMBER="" Q
|
|---|
| 83 | . . . I $E($P($G(RCFCHECK),"^",2))="E",NUMBER'=$P(RCFCHECK,"^") S NUMBER="" Q
|
|---|
| 84 | . . . I $E($P($G(RCFCHECK),"^",2))="C",NUMBER'[$P(RCFCHECK,"^") S NUMBER="" Q
|
|---|
| 85 | . . . I NUMBER="" S NUMBER=" "
|
|---|
| 86 | . . I $E(TYPE,1,5)="TRACE" D Q:NUMBER=""
|
|---|
| 87 | . . . S NUMBER=$P($G(^RCY(344.4,+$P(RECDATA,U,18),0)),U,2)
|
|---|
| 88 | . . . I $G(RCFTRACE)'="",NUMBER="" Q
|
|---|
| 89 | . . . I $E($P($G(RCFTRACE),"^",2))="E",NUMBER'=$P(RCFTRACE,"^") S NUMBER="" Q
|
|---|
| 90 | . . . I $E($P($G(RCFTRACE),"^",2))="C",NUMBER'[$P(RCFTRACE,"^") S NUMBER="" Q
|
|---|
| 91 | . . . I NUMBER="" S NUMBER=" "
|
|---|
| 92 | . . I $E(TYPE,1,6)="CREDIT" D Q:NUMBER=""
|
|---|
| 93 | . . . S NUMBER=$P(RCDATA,"^",11)
|
|---|
| 94 | . . . I $G(RCFCHECK)'="",NUMBER="" Q
|
|---|
| 95 | . . . I $E($P($G(RCFCREDT),"^",2))="E",NUMBER'=$P(RCFCREDT,"^") S NUMBER="" Q
|
|---|
| 96 | . . . I $E($P($G(RCFCREDT),"^",2))="C",NUMBER'[$P(RCFCREDT,"^") S NUMBER="" Q
|
|---|
| 97 | . . . I NUMBER="" S NUMBER=" "
|
|---|
| 98 | . . I NUMBER="" S NUMBER=" "
|
|---|
| 99 | . . S %=$L(NUMBER) I %>8 S NUMBER=$E(NUMBER,%-7,%)
|
|---|
| 100 | . . ; check/trace/credit# (last 8 chars)
|
|---|
| 101 | . . D SET(NUMBER,RCLINE,62,69)
|
|---|
| 102 | . . ; amount paid
|
|---|
| 103 | . . D SET($J($P(RCDATA,"^",4),10,2),RCLINE,70,80)
|
|---|
| 104 | . . ; since list manager adds spaces to line, make sure line is
|
|---|
| 105 | . . ; 80 characters so the print list looks okay
|
|---|
| 106 | . . S ^TMP("RCDPLPLM",$J,RCLINE,0)=$E(^TMP("RCDPLPLM",$J,RCLINE,0),1,80)
|
|---|
| 107 | . . S RCTOTAL=$G(RCTOTAL)+$P(RCDATA,"^",4)
|
|---|
| 108 | . . ;
|
|---|
| 109 | . . ; show line 2
|
|---|
| 110 | . . ; account lookup
|
|---|
| 111 | . . S RCLINE=RCLINE+1
|
|---|
| 112 | . . S %=$E("AcctLU: "_$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^")_" ",1,24)
|
|---|
| 113 | . . D SET(" "_%,RCLINE,1,80)
|
|---|
| 114 | . . ; fms cr document
|
|---|
| 115 | . . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
|
|---|
| 116 | . . D SET($E("CRdoc: "_$P(FMSDOC,"^")_" ",1,22),RCLINE,41,80)
|
|---|
| 117 | . . ; cr document status
|
|---|
| 118 | . . D SET($P(FMSDOC,"^",2),RCLINE,63,68)
|
|---|
| 119 | . . ; make second line longer than 80 characters for printing
|
|---|
| 120 | . . ; this will add an extra line after each entry
|
|---|
| 121 | . . D SET(" ",RCLINE,80,84)
|
|---|
| 122 | ;
|
|---|
| 123 | S RCLINE=RCLINE+1 D SET("----------",RCLINE,70,80)
|
|---|
| 124 | S RCLINE=RCLINE+1 D SET("TOTAL: "_$J($G(RCTOTAL),10,2),RCLINE,63,80)
|
|---|
| 125 | ;
|
|---|
| 126 | ; set valmcnt to number of lines in the list
|
|---|
| 127 | S VALMCNT=RCLINE
|
|---|
| 128 | D HDR
|
|---|
| 129 | Q
|
|---|
| 130 | ;
|
|---|
| 131 | ;
|
|---|
| 132 | SET(STRING,LINE,COLBEG,COLEND) ; set array
|
|---|
| 133 | I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
|
|---|
| 134 | D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
|
|---|
| 135 | Q
|
|---|
| 136 | ;
|
|---|
| 137 | ;
|
|---|
| 138 | HDR ; header code for list manager display
|
|---|
| 139 | S VALMHDR(1)="Transactions for ALL Unapplied Payments"
|
|---|
| 140 | I $G(RCDPPADT)>0 S Y=RCDPPADT D DD^%DT S VALMHDR(1)="Transactions for Unapplied Payments After "_Y
|
|---|
| 141 | S VALMHDR(2)=" "
|
|---|
| 142 | I $G(RCFCHECK)'="" S VALMHDR(2)=" List of Payments With Check Numbers "_$P(RCFCHECK,"^",2)_" "_$P(RCFCHECK,"^")
|
|---|
| 143 | I $G(RCFTRACE)'="" S VALMHDR(2)=" List of Payments With Trace Numbers "_$P(RCFTRACE,"^",2)_" "_$P(RCFTRACE,"^")
|
|---|
| 144 | I $G(RCFCREDT)'="" S VALMHDR(2)=" List of Payments With Credit Cards "_$P(RCFCREDT,"^",2)_" "_$P(RCFCREDT,"^")
|
|---|
| 145 | Q
|
|---|
| 146 | ;
|
|---|
| 147 | ;
|
|---|
| 148 | EXIT ; exit list manager option and clean up
|
|---|
| 149 | K ^TMP("RCDPLPLM",$J),^TMP("RCDPLPLMUNLINK",$J)
|
|---|
| 150 | Q
|
|---|
