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