RCDPRPLM ; WISC/RFJ-receipt profile List Manager main routine ;31 Oct 2018 09:14:14
;;4.5;Accounts Receivable;**114,148,149,173,196,220,217,321,326,332,375,367,409,432**;Mar 20, 1995;Build 16
;Per VA Directive 6402, this routine should not be modified.
;
; option: Receipt Processing [RCDP RECEIPT PROCESSING]
N RCDPFXIT
;
RECTPROF ;EP from RECEIPT^RCDPLPL1
; Entry point called by link payment to prevent NEWing fast exit var RCDPFXIT
N RCRECTDA
;
F D Q:'RCRECTDA
. W !! S RCRECTDA=$$SELRECT^RCDPUREC(1) ; Allow adding new receipt
. I RCRECTDA<1 S RCRECTDA=0 Q
. D EN^VALM("RCDP RECEIPT PROFILE")
. I $G(RCDPFXIT) S RCRECTDA=0 ; Fast exit
Q
;
INIT ;EP from ListMan template RCDP RECEIPT PROFILE MENU
; EP from CUSTOMIZ^RCDPRPL2
; Initialization for list manager
; Input: RCRECTDA - IEN for the selected receipt (#344)
N DATE,EFTFUND,FMSDOC,GECSDA1,GECSDATA,RCCANCEL,RCEFT,RCDPDATA,RCDPFCAN,RCLINE,RCTOTAL,RCTRDA
N RCZ,RCZ0,RCZ1,RCZ2,X,XX,Z,Z0
K ^TMP("RCDPRPLM",$J),^TMP("VALM VIDEO",$J)
I $G(RCDPFXIT) S VALMQUIT=1 Q ; Fast exit
D DIQ344(RCRECTDA,".02:200")
S RCLINE=0 ; list manager line #
K ^TMP($J,"RCEFT")
S EFTFUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ ",1:"528704/8NZZ ")
S RCEFT=+$O(^RCY(344.3,"ARDEP",+$P($G(^RCY(344,RCRECTDA,0)),U,6),0))
I RCEFT D
. S Z=0 F S Z=$O(^RCY(344.31,"B",RCEFT,Z)) Q:'Z D
.. S Z0=$G(^RCY(344.31,+Z,0))
.. I $P(Z0,U,14) S ^TMP($J,"RCEFT",$P(Z0,U,14))=Z_U_$E($P(Z0,U,2),1,12)
;
S RCTRDA=0
F S RCTRDA=$O(^RCY(344,RCRECTDA,1,RCTRDA)) Q:'RCTRDA D
. D DIQ34401(RCRECTDA,RCTRDA)
. S RCLINE=RCLINE+1 D SET("",RCLINE,1,80,.01)
. ; Check for payment cancelled
. S RCCANCEL=0
. I $P($G(^RCY(344,RCRECTDA,1,RCTRDA,0)),"^",4)=0,$P($G(^(1)),"^")'="" D
.. S RCCANCEL=1,RCDPFCAN=1 D SET("**",RCLINE,5,6)
. ; Account
. I $G(RCDPDATA(344.01,RCTRDA,.03,"E"))="" D
.. S:RCEFT XX=EFTFUND_$P($G(^TMP($J,"RCEFT",RCTRDA)),U,2)
.. S:'RCEFT XX=$$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRDA,0)
.. S RCDPDATA(344.01,RCTRDA,.03,"E")="[ "_XX_" ]"
. D SET("",RCLINE,7,25,.03) ;33->25 PRCA*4.5*432
. ; (#.06) DATE OF PAYMENT [6D]
. S X=RCDPDATA(344.01,RCTRDA,.06,"I") D:X
.. S XX=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) D SET(XX,RCLINE,34,41) ;35->34, 42->41 PRCA*4.5*432
. ;( #.12) ENTERED BY [12P:200]
. S X=RCDPDATA(344.01,RCTRDA,.12,"E") D:$L(X)
.. ; if POSTMASTER set to 'ar' else user's initials
.. S X=$S(RCDPDATA(344.01,RCTRDA,.12,"I")=.5:"ar",1:$E($P(X,",",2))_$E(X))
.. D SET(X,RCLINE,44,46) ;45->44 PRCA*4.5*432
. ;(#.14) EDITED BY [14P:200]
. S X=RCDPDATA(344.01,RCTRDA,.14,"E") D:$L(X)
.. S X=$E($P(X,",",2))_$E(X) D SET(X,RCLINE,50,55) ;54->50 PRCA*4.5*432
. S:RCDPDATA(344.01,RCTRDA,.29,"I")="D" RCDPDATA(344.01,RCTRDA,.04,"E")=-RCDPDATA(344.01,RCTRDA,.04,"E") ; PRCA*4.5*375 - Use negative amounts when debit
. D SET($J(RCDPDATA(344.01,RCTRDA,.04,"E"),11,2),RCLINE,56,67) ; (#.04) PAYMENT AMOUNT [4N], 8->11, 62->56, 70->67 PRCA*4.5*432
. D SET($J(RCDPDATA(344.01,RCTRDA,.05,"E"),11,2),RCLINE,69,80) ; (#.05) AMOUNT PROCESSED [5N], 8->11, 72->69 PRCA*4.5*432
. ;
. ; If not processed, show if amount > bill
. S X=$$CHECKPAY^RCDPRPL3(RCRECTDA,RCTRDA) D:X
.. S XX=" WARNING: Pending Payments ($ "_$J($P(X,"^",3),0,2)_") exceed amount billed ($ "_$J($P(X,"^",2),0,2)_")"
.. S RCLINE=RCLINE+1 D SET(XX,RCLINE,1,80)
. ; Show line 2 for check/credit payment
. I $$OPTCK^RCDPRPL2("SHOWCHECK",2) D
.. ; Receipt type is check (4), lockbox (12) or OGC-CHK (19) ; PRCA*4.5*409
.. I "^4^12^19^"[("^"_RCDPDATA(344,RCRECTDA,.04,"I")_"^") D Q
... S RCLINE=RCLINE+1 D SET(" Check #",RCLINE,1,80,.07)
... S X=RCDPDATA(344.01,RCTRDA,.1,"I") S:'X X="???????"
... S XX="Date: "_$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) D SET(XX,RCLINE,32,80)
... D SET("Bank #",RCLINE,47,80,.08)
.. ; Receipt type of payment is credit
.. I RCDPDATA(344,RCRECTDA,.04,"I")=7 D Q
... S RCLINE=RCLINE+1 D SET(" Card #",RCLINE,1,80,.11),SET("Confirmation #",RCLINE,35,80,.02)
.. ; type of payment is EDI LOCKBOX
.. I RCDPDATA(344,RCRECTDA,.04,"I")=14!(RCDPDATA(344,RCRECTDA,.04,"I")=18) D Q ; PRCA*4.5*409
... S RCLINE=RCLINE+1 D SET(" Trace #",RCLINE,1,80,.17)
. ; line 3 for acct. lookup, batch #, sequence #
. I $$OPTCK^RCDPRPL2("SHOWACCT",2) D
.. N TRNS ; transaction info
.. S TRNS("acctLkup")=RCDPDATA(344.01,RCTRDA,.21,"E") ; (#.21) ACCOUNT LOOKUP [1F]
.. S TRNS("btch#")=RCDPDATA(344.01,RCTRDA,.22,"E") ; (#.22) BATCH NUMBER [2N]
.. S TRNS("sq#")=RCDPDATA(344.01,RCTRDA,.23,"E") ; (#.23) SEQUENCE NUMBER [3N]
.. I TRNS("acctLkup")="",TRNS("btch#")="",TRNS("sq#")="" Q ; No Account information, skip
.. S RCLINE=RCLINE+1
.. D SET(" AcctLU",RCLINE,1,80,.21),SET("Batch/Sequence: "_TRNS("btch#")_"/"_TRNS("sq#"),RCLINE,37,80)
. ; Show if posting error
. I $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2),RCDPDATA(344.01,RCTRDA,1.01,"E")'="" D
.. S X=$S(RCCANCEL:"Cancel Data",1:"Posting Error")
.. S RCLINE=RCLINE+1 D SET(" "_X,RCLINE,1,80,1.01)
. ; Show if comment
. I $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2),RCDPDATA(344.01,RCTRDA,1.02,"E")'="" D
.. S RCLINE=RCLINE+1 D SET(" Comment",RCLINE,1,80,1.02)
. ; If EDI Lockbox pending adjustments, show it
. I $P($G(^RCY(344,RCRECTDA,0)),U,18),$G(RCDPDATA(344.01,RCTRDA,.27,"E")) D
.. S RCZ=$P(^RCY(344,RCRECTDA,0),U,18),RCZ0=RCDPDATA(344.01,RCTRDA,.27,"E")
.. S RCZ1=0 F S RCZ1=$O(^RCY(344.49,RCZ,1,RCZ0,1,RCZ1)) Q:'RCZ1 S RCZ2=$G(^(RCZ1,0)) D
... I $P(RCZ2,U,5)'="","12"[$P(RCZ2,U,5),'$P(RCZ2,U,8) D
.... I $P(RCZ2,U,5)=1 D Q
..... S RCLINE=RCLINE+1 D SET(" Pending decrease adjustment for "_$J($P(RCZ2,U,3),"",2),RCLINE,1,80)
.... I $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2),$P(RCZ2,U,5)=2 D Q
..... S RCLINE=RCLINE+1 D SET(" Comment: "_$P(RCZ2,U,9),RCLINE,1,80)
. ; Calculate totals
. S RCTOTAL(1)=$G(RCTOTAL(1))+RCDPDATA(344.01,RCTRDA,.04,"E")
. S RCTOTAL(2)=$G(RCTOTAL(2))+RCDPDATA(344.01,RCTRDA,.05,"E")
. ; cleanup
. K RCDPDATA(344.01,RCTRDA)
;
; Show totals
K ^TMP($J,"RCEFT")
S RCLINE=RCLINE+1 D SET("",RCLINE,1,80),SET("----------- -----------",RCLINE,56,80) ;62->56, ADD DASHES PRCA*4.5*432
S RCLINE=RCLINE+1 D SET(" TOTAL DOLLARS FOR RECEIPT",RCLINE,1,80)
D SET($J($G(RCTOTAL(1)),11,2),RCLINE,56,67) ;8->11, 62->56, 70->67 PRCA*4.5*432
D SET($J($G(RCTOTAL(2)),11,2),RCLINE,69,80) ;8->11, 72->69 PRCA*4.5*432
;
; Show cancelled
I $G(RCDPFCAN) S RCLINE=RCLINE+1 D SET("**indicates payment is CANCELLED",RCLINE,5,80)
;
; Show history
S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
;
; Start history on first line of a screen if it does not fit on current screen
I (RCLINE#12)>8 F X=(RCLINE#12):1:12 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
S RCLINE=RCLINE+1 D SET("Receipt History",RCLINE,1,80,0,IOUON,IOUOFF)
S DATE=RCDPDATA(344,RCRECTDA,.03,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
I RCDPDATA(344,RCRECTDA,.02,"I")=.5 S RCDPDATA(344,RCRECTDA,.02,"E")="accounts receivable"
S XX=$E(" Opened By: "_RCDPDATA(344,RCRECTDA,.02,"E")_$$SP,1,39)_"Date/Time Opened: "_DATE
S RCLINE=RCLINE+1 D SET(XX,RCLINE,1,80)
; (#.12) DATE/TIME LAST EDIT [12D]
S DATE=RCDPDATA(344,RCRECTDA,.12,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
S X=RCDPDATA(344,RCRECTDA,.11,"E") I RCDPDATA(344,RCRECTDA,.11,"I")=.5 S X="accounts receivable"
S XX=$E("Last Edit By: "_X_$$SP,1,39)_"Date/Time Last Edit: "_DATE
S RCLINE=RCLINE+1 D SET(XX,RCLINE,1,80)
; (#.08) DATE/TIME PROCESSED [8D]
S DATE=RCDPDATA(344,RCRECTDA,.08,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2)
I RCDPDATA(344,RCRECTDA,.07,"I")=.5 S RCDPDATA(344,RCRECTDA,.07,"E")="accounts receivable"
S XX=$E("Processed By: "_RCDPDATA(344,RCRECTDA,.07,"E")_$$SP,1,39)_"Date/Time Processed: "_DATE
S RCLINE=RCLINE+1 D SET(XX,RCLINE,1,80)
;
; Show FMS code sheets if switch on in file 342.3
I $$OPTCK^RCDPRPL2("SHOWFMS",2) D
. S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
. S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
. S RCLINE=RCLINE+1 D SET("FMS Cash Receipt Document:",RCLINE,1,80,0,IOUON,IOUOFF)
. D SET($P(FMSDOC,"^")_$S($P(FMSDOC,"^",3):"(on deposit)",1:""),RCLINE,28,80)
. D SET("Status: "_$P(FMSDOC,"^",2),RCLINE,55,80)
. D DATA^GECSSGET($P(FMSDOC,"^"),1)
. I '$G(GECSDATA) Q
. S GECSDA1=0 F S GECSDA1=$O(GECSDATA(2100.1,GECSDATA,10,GECSDA1)) Q:'GECSDA1 D
.. S RCLINE=RCLINE+1 D SET(GECSDATA(2100.1,GECSDATA,10,GECSDA1),RCLINE,1,80)
;
; Show EEOB detail if switch on
D SHEOB^RCDPRPL2
;
; # of lines in list
S VALMCNT=RCLINE
D HDR
Q
;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; Sets a line into the body
; of the ListMan template
; Input:
; STRING - Label for the data being set
; LINE - line # being built
; COLBEG - Beginning column for the text
; COLEND - Ending column for the text
; FIELD - Field # for value being set, optional
; NOTE: if FIELD is .17 trace # is retrieved from EFT record
; ON, OFF - for text characteristics
; RCDPDATA - array for receipt being processed
; RCTRDA - IEN in TRANSACTION sub-file (#344.01)
N XX
I $G(FIELD) D
. I FIELD=.17 S XX=$$TRCNUM(RCRECTDA) Q ; trace # from EFT record, PRCA*4.5*332
. ; all other fields
. S XX=$G(RCDPDATA(344.01,RCTRDA,FIELD,"E"))
S:$G(FIELD) STRING=STRING_$S(STRING="":"",1:": ")_XX
I STRING="",'$G(FIELD) D SET^VALM10(LINE,$J("",80)) Q
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))
I $G(ON)'=""!($G(OFF)'="") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
Q
;
TRCNUM(ARBPIEN) ; returns trace #, ARBPIEN is IEN in file #344 - PRCA*4.5*332
N DEPIEN,PTR
; If receipt manually created then EFT number is in field .17
S PTR=+$P($G(^RCY(344,ARBPIEN,0)),U,17) ;(#.17) EFT RECORD [17P:344.31]
; Otherwise auto-posting created the receipt, get the EFT number
D:'PTR
. S DEPIEN=+$P($G(^RCY(344,ARBPIEN,0)),U,6) ; (#.06) DEPOSIT TICKET [6P:344.1]
. S PTR=+$O(^RCY(344.3,"ARDEP",DEPIEN,0)) ; use deposit IEN to get IEN in fil #344.3
. S PTR=+$O(^RCY(344.31,"B",PTR,0)) ; Get the EFT Number
;
Q $$GET1^DIQ(344.31,PTR_",",.04,"E") ;(#.04) TRACE # [4F]
;
DIQ344(DA,DR) ; Retrieves data for fields in file #344
; Input: DA - IEN of the receipt to retrieve data from (#344)
; DR - List of fields to retrieve data for
; Output: RCDPDATA - Array of retrieved data
N %I,D0,DIC,DIQ,YY
K RCDPDATA(344,DA)
S DIQ(0)="IE",DIC="^RCY(344,",DIQ="RCDPDATA"
D EN^DIQ1
Q
;
DIQ34401(DA,SUBDA) ; Retrieves data for fields in the transaction subfile (#344.01)
; of the receipt file (#344)
; Input: DA - IEN of the receipt to retrieve data from (#344)
; SUBDA - IEN of the sub-file record (#344.01)
; Output: RCDPDATA - Array of retrieved data
N %I,D0,DIC,DIQ,DR
K RCDPDATA(344.01,SUBDA)
S DR=1,DR(344.01)=".01:1.02",DA(344.01)=SUBDA
S DIQ(0)="IE",DIC="^RCY(344,",DIQ="RCDPDATA"
D EN^DIQ1
Q
;
HDR ;EP from ListMan Template RCDP RECEIPT PROFILE
; Header code for list manager display
N DATE,DEPIEN,EFTIEN,ERAIEN,FMSDOC,FMSTTR,PAYER,RCDPDATA,RCEFT,RCHMP,RCTOT,XX,Z
D DIQ344(RCRECTDA,".01;.04;.06;.08;.14;.17;.18;.22")
;
; PRCA*4.5*321 - Start of modified code block
S XX=$E(" Receipt #: "_RCDPDATA(344,RCRECTDA,.01,"E")_$$SP,1,39)
S XX=XX_"Type of Payment: "_RCDPDATA(344,RCRECTDA,.04,"E")
S VALMHDR(1)=XX
;
S Z=RCDPDATA(344,RCRECTDA,.06,"E")
S DEPIEN=+$P($G(^RCY(344,RCRECTDA,0)),U,6)
S RCEFT=+$O(^RCY(344.3,"ARDEP",DEPIEN,0))
S EFTIEN=RCDPDATA(344,RCRECTDA,.17,"I")
S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
S FMSTTR=$S($P(FMSDOC,"-",1)="TR":1,1:0)
S RCHMP=$$ISCHMPVA^RCDPUREC(RCDPDATA(344,RCRECTDA,.04,"I")) ; PRCA*4.5*367 - Is this a CHAMPVA receipt
S RCTOT=+RCDPDATA(344,RCRECTDA,.22,"E") ; PRCA*4.5*367 - Add Receipt Total to Header
S XX="" D
. ; PRCA*4.5*367 - If CHAMPVA receipt, display receipt total instead of receipt
. I RCHMP S XX=" Receipt Total: "_$FN(RCTOT,",",2) Q
. I 'RCEFT&'EFTIEN S XX=" Deposit #: "_Z Q
. I RCEFT S XX=" EFT Deposit: "_Z Q
. ; PRCA*4.5*321 - Since EFT and ERA are now displayed on their own line, put TIN/Payer here
. N TIN
. S PAYER=$$GET1^DIQ(344.31,EFTIEN_",",.02,"E")
. S TIN=$$GET1^DIQ(344.31,EFTIEN_",",.03,"E")
. S XX=" Payer: "_TIN_"/"_PAYER
S XX=$E(XX_$$SP,1,39)_" Receipt Status: "_RCDPDATA(344,RCRECTDA,.14,"E")
S VALMHDR(2)=XX
;
S ERAIEN=RCDPDATA(344,RCRECTDA,.18,"I")
S XX=""
I FMSTTR!ERAIEN S XX=" ERA #: "_RCDPDATA(344,RCRECTDA,.18,"E")
S XX=$E(XX_$$SP,1,21)
I FMSTTR!ERAIEN S XX=XX_"ERA TTL: "_$J($$GET1^DIQ(344.4,ERAIEN_",",.05,"E"),9)
S XX=$E(XX_$$SP,1,39)
;
; FMS document and status
S XX=XX_" FMS Document: "_$TR($P(FMSDOC,"^")," ")_$S($P(FMSDOC,"^",3):"(on deposit)",1:"")
S VALMHDR(3)=XX
;
S XX=""
I FMSTTR!EFTIEN D
. S XX=" EFT #: "_$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")_"."
. S XX=XX_$$GET1^DIQ(344.31,EFTIEN_",",.14) ; PRCA*4.5*326
S XX=$E(XX_$$SP,1,21)
I FMSTTR!EFTIEN S XX=XX_"EFT TTL: "_$J($$GET1^DIQ(344.31,EFTIEN_",",.07,"E"),9)_" "
S XX=$E(XX_$$SP,1,39)
S XX=XX_" FMS Doc Status: "_$P(FMSDOC,"^",2)
S VALMHDR(4)=XX
; PRCA*4.5*321 - End of modified code block
;
I RCDPDATA(344,RCRECTDA,.08,"I") D
. S VALMSG="Receipt processed on "_RCDPDATA(344,RCRECTDA,.08,"E")
Q
;
EXIT ;EP from ListMan Template RCDP RECEIPT PROFILE
; Exit option/clean up
K ^TMP("RCDPRPLM",$J)
Q
;
SP() Q $J("",132) ; extrinsic variable, 132 spaces
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRPLM 13650 printed Sep 23, 2025@19:22:27 Page 2
RCDPRPLM ; WISC/RFJ-receipt profile List Manager main routine ;31 Oct 2018 09:14:14
+1 ;;4.5;Accounts Receivable;**114,148,149,173,196,220,217,321,326,332,375,367,409,432**;Mar 20, 1995;Build 16
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; option: Receipt Processing [RCDP RECEIPT PROCESSING]
+5 NEW RCDPFXIT
+6 ;
RECTPROF ;EP from RECEIPT^RCDPLPL1
+1 ; Entry point called by link payment to prevent NEWing fast exit var RCDPFXIT
+2 NEW RCRECTDA
+3 ;
+4 FOR
Begin DoDot:1
+5 ; Allow adding new receipt
WRITE !!
SET RCRECTDA=$$SELRECT^RCDPUREC(1)
+6 IF RCRECTDA<1
SET RCRECTDA=0
QUIT
+7 DO EN^VALM("RCDP RECEIPT PROFILE")
+8 ; Fast exit
IF $GET(RCDPFXIT)
SET RCRECTDA=0
End DoDot:1
if 'RCRECTDA
QUIT
+9 QUIT
+10 ;
INIT ;EP from ListMan template RCDP RECEIPT PROFILE MENU
+1 ; EP from CUSTOMIZ^RCDPRPL2
+2 ; Initialization for list manager
+3 ; Input: RCRECTDA - IEN for the selected receipt (#344)
+4 NEW DATE,EFTFUND,FMSDOC,GECSDA1,GECSDATA,RCCANCEL,RCEFT,RCDPDATA,RCDPFCAN,RCLINE,RCTOTAL,RCTRDA
+5 NEW RCZ,RCZ0,RCZ1,RCZ2,X,XX,Z,Z0
+6 KILL ^TMP("RCDPRPLM",$JOB),^TMP("VALM VIDEO",$JOB)
+7 ; Fast exit
IF $GET(RCDPFXIT)
SET VALMQUIT=1
QUIT
+8 DO DIQ344(RCRECTDA,".02:200")
+9 ; list manager line #
SET RCLINE=0
+10 KILL ^TMP($JOB,"RCEFT")
+11 SET EFTFUND=$SELECT(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ ",1:"528704/8NZZ ")
+12 SET RCEFT=+$ORDER(^RCY(344.3,"ARDEP",+$PIECE($GET(^RCY(344,RCRECTDA,0)),U,6),0))
+13 IF RCEFT
Begin DoDot:1
+14 SET Z=0
FOR
SET Z=$ORDER(^RCY(344.31,"B",RCEFT,Z))
if 'Z
QUIT
Begin DoDot:2
+15 SET Z0=$GET(^RCY(344.31,+Z,0))
+16 IF $PIECE(Z0,U,14)
SET ^TMP($JOB,"RCEFT",$PIECE(Z0,U,14))=Z_U_$EXTRACT($PIECE(Z0,U,2),1,12)
End DoDot:2
End DoDot:1
+17 ;
+18 SET RCTRDA=0
+19 FOR
SET RCTRDA=$ORDER(^RCY(344,RCRECTDA,1,RCTRDA))
if 'RCTRDA
QUIT
Begin DoDot:1
+20 DO DIQ34401(RCRECTDA,RCTRDA)
+21 SET RCLINE=RCLINE+1
DO SET("",RCLINE,1,80,.01)
+22 ; Check for payment cancelled
+23 SET RCCANCEL=0
+24 IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCTRDA,0)),"^",4)=0
IF $PIECE($GET(^(1)),"^")'=""
Begin DoDot:2
+25 SET RCCANCEL=1
SET RCDPFCAN=1
DO SET("**",RCLINE,5,6)
End DoDot:2
+26 ; Account
+27 IF $GET(RCDPDATA(344.01,RCTRDA,.03,"E"))=""
Begin DoDot:2
+28 if RCEFT
SET XX=EFTFUND_$PIECE($GET(^TMP($JOB,"RCEFT",RCTRDA)),U,2)
+29 if 'RCEFT
SET XX=$$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRDA,0)
+30 SET RCDPDATA(344.01,RCTRDA,.03,"E")="[ "_XX_" ]"
End DoDot:2
+31 ;33->25 PRCA*4.5*432
DO SET("",RCLINE,7,25,.03)
+32 ; (#.06) DATE OF PAYMENT [6D]
+33 SET X=RCDPDATA(344.01,RCTRDA,.06,"I")
if X
Begin DoDot:2
+34 ;35->34, 42->41 PRCA*4.5*432
SET XX=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
DO SET(XX,RCLINE,34,41)
End DoDot:2
+35 ;( #.12) ENTERED BY [12P:200]
+36 SET X=RCDPDATA(344.01,RCTRDA,.12,"E")
if $LENGTH(X)
Begin DoDot:2
+37 ; if POSTMASTER set to 'ar' else user's initials
+38 SET X=$SELECT(RCDPDATA(344.01,RCTRDA,.12,"I")=.5:"ar",1:$EXTRACT($PIECE(X,",",2))_$EXTRACT(X))
+39 ;45->44 PRCA*4.5*432
DO SET(X,RCLINE,44,46)
End DoDot:2
+40 ;(#.14) EDITED BY [14P:200]
+41 SET X=RCDPDATA(344.01,RCTRDA,.14,"E")
if $LENGTH(X)
Begin DoDot:2
+42 ;54->50 PRCA*4.5*432
SET X=$EXTRACT($PIECE(X,",",2))_$EXTRACT(X)
DO SET(X,RCLINE,50,55)
End DoDot:2
+43 ; PRCA*4.5*375 - Use negative amounts when debit
if RCDPDATA(344.01,RCTRDA,.29,"I")="D"
SET RCDPDATA(344.01,RCTRDA,.04,"E")=-RCDPDATA(344.01,RCTRDA,.04,"E")
+44 ; (#.04) PAYMENT AMOUNT [4N], 8->11, 62->56, 70->67 PRCA*4.5*432
DO SET($JUSTIFY(RCDPDATA(344.01,RCTRDA,.04,"E"),11,2),RCLINE,56,67)
+45 ; (#.05) AMOUNT PROCESSED [5N], 8->11, 72->69 PRCA*4.5*432
DO SET($JUSTIFY(RCDPDATA(344.01,RCTRDA,.05,"E"),11,2),RCLINE,69,80)
+46 ;
+47 ; If not processed, show if amount > bill
+48 SET X=$$CHECKPAY^RCDPRPL3(RCRECTDA,RCTRDA)
if X
Begin DoDot:2
+49 SET XX=" WARNING: Pending Payments ($ "_$JUSTIFY($PIECE(X,"^",3),0,2)_") exceed amount billed ($ "_$JUSTIFY($PIECE(X,"^",2),0,2)_")"
+50 SET RCLINE=RCLINE+1
DO SET(XX,RCLINE,1,80)
End DoDot:2
+51 ; Show line 2 for check/credit payment
+52 IF $$OPTCK^RCDPRPL2("SHOWCHECK",2)
Begin DoDot:2
+53 ; Receipt type is check (4), lockbox (12) or OGC-CHK (19) ; PRCA*4.5*409
+54 IF "^4^12^19^"[("^"_RCDPDATA(344,RCRECTDA,.04,"I")_"^")
Begin DoDot:3
+55 SET RCLINE=RCLINE+1
DO SET(" Check #",RCLINE,1,80,.07)
+56 SET X=RCDPDATA(344.01,RCTRDA,.1,"I")
if 'X
SET X="???????"
+57 SET XX="Date: "_$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
DO SET(XX,RCLINE,32,80)
+58 DO SET("Bank #",RCLINE,47,80,.08)
End DoDot:3
QUIT
+59 ; Receipt type of payment is credit
+60 IF RCDPDATA(344,RCRECTDA,.04,"I")=7
Begin DoDot:3
+61 SET RCLINE=RCLINE+1
DO SET(" Card #",RCLINE,1,80,.11)
DO SET("Confirmation #",RCLINE,35,80,.02)
End DoDot:3
QUIT
+62 ; type of payment is EDI LOCKBOX
+63 ; PRCA*4.5*409
IF RCDPDATA(344,RCRECTDA,.04,"I")=14!(RCDPDATA(344,RCRECTDA,.04,"I")=18)
Begin DoDot:3
+64 SET RCLINE=RCLINE+1
DO SET(" Trace #",RCLINE,1,80,.17)
End DoDot:3
QUIT
End DoDot:2
+65 ; line 3 for acct. lookup, batch #, sequence #
+66 IF $$OPTCK^RCDPRPL2("SHOWACCT",2)
Begin DoDot:2
+67 ; transaction info
NEW TRNS
+68 ; (#.21) ACCOUNT LOOKUP [1F]
SET TRNS("acctLkup")=RCDPDATA(344.01,RCTRDA,.21,"E")
+69 ; (#.22) BATCH NUMBER [2N]
SET TRNS("btch#")=RCDPDATA(344.01,RCTRDA,.22,"E")
+70 ; (#.23) SEQUENCE NUMBER [3N]
SET TRNS("sq#")=RCDPDATA(344.01,RCTRDA,.23,"E")
+71 ; No Account information, skip
IF TRNS("acctLkup")=""
IF TRNS("btch#")=""
IF TRNS("sq#")=""
QUIT
+72 SET RCLINE=RCLINE+1
+73 DO SET(" AcctLU",RCLINE,1,80,.21)
DO SET("Batch/Sequence: "_TRNS("btch#")_"/"_TRNS("sq#"),RCLINE,37,80)
End DoDot:2
+74 ; Show if posting error
+75 IF $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2)
IF RCDPDATA(344.01,RCTRDA,1.01,"E")'=""
Begin DoDot:2
+76 SET X=$SELECT(RCCANCEL:"Cancel Data",1:"Posting Error")
+77 SET RCLINE=RCLINE+1
DO SET(" "_X,RCLINE,1,80,1.01)
End DoDot:2
+78 ; Show if comment
+79 IF $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2)
IF RCDPDATA(344.01,RCTRDA,1.02,"E")'=""
Begin DoDot:2
+80 SET RCLINE=RCLINE+1
DO SET(" Comment",RCLINE,1,80,1.02)
End DoDot:2
+81 ; If EDI Lockbox pending adjustments, show it
+82 IF $PIECE($GET(^RCY(344,RCRECTDA,0)),U,18)
IF $GET(RCDPDATA(344.01,RCTRDA,.27,"E"))
Begin DoDot:2
+83 SET RCZ=$PIECE(^RCY(344,RCRECTDA,0),U,18)
SET RCZ0=RCDPDATA(344.01,RCTRDA,.27,"E")
+84 SET RCZ1=0
FOR
SET RCZ1=$ORDER(^RCY(344.49,RCZ,1,RCZ0,1,RCZ1))
if 'RCZ1
QUIT
SET RCZ2=$GET(^(RCZ1,0))
Begin DoDot:3
+85 IF $PIECE(RCZ2,U,5)'=""
IF "12"[$PIECE(RCZ2,U,5)
IF '$PIECE(RCZ2,U,8)
Begin DoDot:4
+86 IF $PIECE(RCZ2,U,5)=1
Begin DoDot:5
+87 SET RCLINE=RCLINE+1
DO SET(" Pending decrease adjustment for "_$JUSTIFY($PIECE(RCZ2,U,3),"",2),RCLINE,1,80)
End DoDot:5
QUIT
+88 IF $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2)
IF $PIECE(RCZ2,U,5)=2
Begin DoDot:5
+89 SET RCLINE=RCLINE+1
DO SET(" Comment: "_$PIECE(RCZ2,U,9),RCLINE,1,80)
End DoDot:5
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
+90 ; Calculate totals
+91 SET RCTOTAL(1)=$GET(RCTOTAL(1))+RCDPDATA(344.01,RCTRDA,.04,"E")
+92 SET RCTOTAL(2)=$GET(RCTOTAL(2))+RCDPDATA(344.01,RCTRDA,.05,"E")
+93 ; cleanup
+94 KILL RCDPDATA(344.01,RCTRDA)
End DoDot:1
+95 ;
+96 ; Show totals
+97 KILL ^TMP($JOB,"RCEFT")
+98 ;62->56, ADD DASHES PRCA*4.5*432
SET RCLINE=RCLINE+1
DO SET("",RCLINE,1,80)
DO SET("----------- -----------",RCLINE,56,80)
+99 SET RCLINE=RCLINE+1
DO SET(" TOTAL DOLLARS FOR RECEIPT",RCLINE,1,80)
+100 ;8->11, 62->56, 70->67 PRCA*4.5*432
DO SET($JUSTIFY($GET(RCTOTAL(1)),11,2),RCLINE,56,67)
+101 ;8->11, 72->69 PRCA*4.5*432
DO SET($JUSTIFY($GET(RCTOTAL(2)),11,2),RCLINE,69,80)
+102 ;
+103 ; Show cancelled
+104 IF $GET(RCDPFCAN)
SET RCLINE=RCLINE+1
DO SET("**indicates payment is CANCELLED",RCLINE,5,80)
+105 ;
+106 ; Show history
+107 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+108 ;
+109 ; Start history on first line of a screen if it does not fit on current screen
+110 IF (RCLINE#12)>8
FOR X=(RCLINE#12):1:12
SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+111 SET RCLINE=RCLINE+1
DO SET("Receipt History",RCLINE,1,80,0,IOUON,IOUOFF)
+112 SET DATE=RCDPDATA(344,RCRECTDA,.03,"E")
SET DATE=$PIECE(DATE,"@")_" "_$PIECE($PIECE(DATE,"@",2),":",1,2)
+113 IF RCDPDATA(344,RCRECTDA,.02,"I")=.5
SET RCDPDATA(344,RCRECTDA,.02,"E")="accounts receivable"
+114 SET XX=$EXTRACT(" Opened By: "_RCDPDATA(344,RCRECTDA,.02,"E")_$$SP,1,39)_"Date/Time Opened: "_DATE
+115 SET RCLINE=RCLINE+1
DO SET(XX,RCLINE,1,80)
+116 ; (#.12) DATE/TIME LAST EDIT [12D]
+117 SET DATE=RCDPDATA(344,RCRECTDA,.12,"E")
SET DATE=$PIECE(DATE,"@")_" "_$PIECE($PIECE(DATE,"@",2),":",1,2)
+118 SET X=RCDPDATA(344,RCRECTDA,.11,"E")
IF RCDPDATA(344,RCRECTDA,.11,"I")=.5
SET X="accounts receivable"
+119 SET XX=$EXTRACT("Last Edit By: "_X_$$SP,1,39)_"Date/Time Last Edit: "_DATE
+120 SET RCLINE=RCLINE+1
DO SET(XX,RCLINE,1,80)
+121 ; (#.08) DATE/TIME PROCESSED [8D]
+122 SET DATE=RCDPDATA(344,RCRECTDA,.08,"E")
SET DATE=$PIECE(DATE,"@")_" "_$PIECE($PIECE(DATE,"@",2),":",1,2)
+123 IF RCDPDATA(344,RCRECTDA,.07,"I")=.5
SET RCDPDATA(344,RCRECTDA,.07,"E")="accounts receivable"
+124 SET XX=$EXTRACT("Processed By: "_RCDPDATA(344,RCRECTDA,.07,"E")_$$SP,1,39)_"Date/Time Processed: "_DATE
+125 SET RCLINE=RCLINE+1
DO SET(XX,RCLINE,1,80)
+126 ;
+127 ; Show FMS code sheets if switch on in file 342.3
+128 IF $$OPTCK^RCDPRPL2("SHOWFMS",2)
Begin DoDot:1
+129 SET FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
+130 SET RCLINE=RCLINE+1
DO SET(" ",RCLINE,1,80)
+131 SET RCLINE=RCLINE+1
DO SET("FMS Cash Receipt Document:",RCLINE,1,80,0,IOUON,IOUOFF)
+132 DO SET($PIECE(FMSDOC,"^")_$SELECT($PIECE(FMSDOC,"^",3):"(on deposit)",1:""),RCLINE,28,80)
+133 DO SET("Status: "_$PIECE(FMSDOC,"^",2),RCLINE,55,80)
+134 DO DATA^GECSSGET($PIECE(FMSDOC,"^"),1)
+135 IF '$GET(GECSDATA)
QUIT
+136 SET GECSDA1=0
FOR
SET GECSDA1=$ORDER(GECSDATA(2100.1,GECSDATA,10,GECSDA1))
if 'GECSDA1
QUIT
Begin DoDot:2
+137 SET RCLINE=RCLINE+1
DO SET(GECSDATA(2100.1,GECSDATA,10,GECSDA1),RCLINE,1,80)
End DoDot:2
End DoDot:1
+138 ;
+139 ; Show EEOB detail if switch on
+140 DO SHEOB^RCDPRPL2
+141 ;
+142 ; # of lines in list
+143 SET VALMCNT=RCLINE
+144 DO HDR
+145 QUIT
+146 ;
SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; Sets a line into the body
+1 ; of the ListMan template
+2 ; Input:
+3 ; STRING - Label for the data being set
+4 ; LINE - line # being built
+5 ; COLBEG - Beginning column for the text
+6 ; COLEND - Ending column for the text
+7 ; FIELD - Field # for value being set, optional
+8 ; NOTE: if FIELD is .17 trace # is retrieved from EFT record
+9 ; ON, OFF - for text characteristics
+10 ; RCDPDATA - array for receipt being processed
+11 ; RCTRDA - IEN in TRANSACTION sub-file (#344.01)
+12 NEW XX
+13 IF $GET(FIELD)
Begin DoDot:1
+14 ; trace # from EFT record, PRCA*4.5*332
IF FIELD=.17
SET XX=$$TRCNUM(RCRECTDA)
QUIT
+15 ; all other fields
+16 SET XX=$GET(RCDPDATA(344.01,RCTRDA,FIELD,"E"))
End DoDot:1
+17 if $GET(FIELD)
SET STRING=STRING_$SELECT(STRING="":"",1:": ")_XX
+18 IF STRING=""
IF '$GET(FIELD)
DO SET^VALM10(LINE,$JUSTIFY("",80))
QUIT
+19 IF '$DATA(@VALMAR@(LINE,0))
DO SET^VALM10(LINE,$JUSTIFY("",80))
+20 DO SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
+21 IF $GET(ON)'=""!($GET(OFF)'="")
DO CNTRL^VALM10(LINE,COLBEG,$LENGTH(STRING),ON,OFF)
+22 QUIT
+23 ;
TRCNUM(ARBPIEN) ; returns trace #, ARBPIEN is IEN in file #344 - PRCA*4.5*332
+1 NEW DEPIEN,PTR
+2 ; If receipt manually created then EFT number is in field .17
+3 ;(#.17) EFT RECORD [17P:344.31]
SET PTR=+$PIECE($GET(^RCY(344,ARBPIEN,0)),U,17)
+4 ; Otherwise auto-posting created the receipt, get the EFT number
+5 if 'PTR
Begin DoDot:1
+6 ; (#.06) DEPOSIT TICKET [6P:344.1]
SET DEPIEN=+$PIECE($GET(^RCY(344,ARBPIEN,0)),U,6)
+7 ; use deposit IEN to get IEN in fil #344.3
SET PTR=+$ORDER(^RCY(344.3,"ARDEP",DEPIEN,0))
+8 ; Get the EFT Number
SET PTR=+$ORDER(^RCY(344.31,"B",PTR,0))
End DoDot:1
+9 ;
+10 ;(#.04) TRACE # [4F]
QUIT $$GET1^DIQ(344.31,PTR_",",.04,"E")
+11 ;
DIQ344(DA,DR) ; Retrieves data for fields in file #344
+1 ; Input: DA - IEN of the receipt to retrieve data from (#344)
+2 ; DR - List of fields to retrieve data for
+3 ; Output: RCDPDATA - Array of retrieved data
+4 NEW %I,D0,DIC,DIQ,YY
+5 KILL RCDPDATA(344,DA)
+6 SET DIQ(0)="IE"
SET DIC="^RCY(344,"
SET DIQ="RCDPDATA"
+7 DO EN^DIQ1
+8 QUIT
+9 ;
DIQ34401(DA,SUBDA) ; Retrieves data for fields in the transaction subfile (#344.01)
+1 ; of the receipt file (#344)
+2 ; Input: DA - IEN of the receipt to retrieve data from (#344)
+3 ; SUBDA - IEN of the sub-file record (#344.01)
+4 ; Output: RCDPDATA - Array of retrieved data
+5 NEW %I,D0,DIC,DIQ,DR
+6 KILL RCDPDATA(344.01,SUBDA)
+7 SET DR=1
SET DR(344.01)=".01:1.02"
SET DA(344.01)=SUBDA
+8 SET DIQ(0)="IE"
SET DIC="^RCY(344,"
SET DIQ="RCDPDATA"
+9 DO EN^DIQ1
+10 QUIT
+11 ;
HDR ;EP from ListMan Template RCDP RECEIPT PROFILE
+1 ; Header code for list manager display
+2 NEW DATE,DEPIEN,EFTIEN,ERAIEN,FMSDOC,FMSTTR,PAYER,RCDPDATA,RCEFT,RCHMP,RCTOT,XX,Z
+3 DO DIQ344(RCRECTDA,".01;.04;.06;.08;.14;.17;.18;.22")
+4 ;
+5 ; PRCA*4.5*321 - Start of modified code block
+6 SET XX=$EXTRACT(" Receipt #: "_RCDPDATA(344,RCRECTDA,.01,"E")_$$SP,1,39)
+7 SET XX=XX_"Type of Payment: "_RCDPDATA(344,RCRECTDA,.04,"E")
+8 SET VALMHDR(1)=XX
+9 ;
+10 SET Z=RCDPDATA(344,RCRECTDA,.06,"E")
+11 SET DEPIEN=+$PIECE($GET(^RCY(344,RCRECTDA,0)),U,6)
+12 SET RCEFT=+$ORDER(^RCY(344.3,"ARDEP",DEPIEN,0))
+13 SET EFTIEN=RCDPDATA(344,RCRECTDA,.17,"I")
+14 SET FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
+15 SET FMSTTR=$SELECT($PIECE(FMSDOC,"-",1)="TR":1,1:0)
+16 ; PRCA*4.5*367 - Is this a CHAMPVA receipt
SET RCHMP=$$ISCHMPVA^RCDPUREC(RCDPDATA(344,RCRECTDA,.04,"I"))
+17 ; PRCA*4.5*367 - Add Receipt Total to Header
SET RCTOT=+RCDPDATA(344,RCRECTDA,.22,"E")
+18 SET XX=""
Begin DoDot:1
+19 ; PRCA*4.5*367 - If CHAMPVA receipt, display receipt total instead of receipt
+20 IF RCHMP
SET XX=" Receipt Total: "_$FNUMBER(RCTOT,",",2)
QUIT
+21 IF 'RCEFT&'EFTIEN
SET XX=" Deposit #: "_Z
QUIT
+22 IF RCEFT
SET XX=" EFT Deposit: "_Z
QUIT
+23 ; PRCA*4.5*321 - Since EFT and ERA are now displayed on their own line, put TIN/Payer here
+24 NEW TIN
+25 SET PAYER=$$GET1^DIQ(344.31,EFTIEN_",",.02,"E")
+26 SET TIN=$$GET1^DIQ(344.31,EFTIEN_",",.03,"E")
+27 SET XX=" Payer: "_TIN_"/"_PAYER
End DoDot:1
+28 SET XX=$EXTRACT(XX_$$SP,1,39)_" Receipt Status: "_RCDPDATA(344,RCRECTDA,.14,"E")
+29 SET VALMHDR(2)=XX
+30 ;
+31 SET ERAIEN=RCDPDATA(344,RCRECTDA,.18,"I")
+32 SET XX=""
+33 IF FMSTTR!ERAIEN
SET XX=" ERA #: "_RCDPDATA(344,RCRECTDA,.18,"E")
+34 SET XX=$EXTRACT(XX_$$SP,1,21)
+35 IF FMSTTR!ERAIEN
SET XX=XX_"ERA TTL: "_$JUSTIFY($$GET1^DIQ(344.4,ERAIEN_",",.05,"E"),9)
+36 SET XX=$EXTRACT(XX_$$SP,1,39)
+37 ;
+38 ; FMS document and status
+39 SET XX=XX_" FMS Document: "_$TRANSLATE($PIECE(FMSDOC,"^")," ")_$SELECT($PIECE(FMSDOC,"^",3):"(on deposit)",1:"")
+40 SET VALMHDR(3)=XX
+41 ;
+42 SET XX=""
+43 IF FMSTTR!EFTIEN
Begin DoDot:1
+44 SET XX=" EFT #: "_$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")_"."
+45 ; PRCA*4.5*326
SET XX=XX_$$GET1^DIQ(344.31,EFTIEN_",",.14)
End DoDot:1
+46 SET XX=$EXTRACT(XX_$$SP,1,21)
+47 IF FMSTTR!EFTIEN
SET XX=XX_"EFT TTL: "_$JUSTIFY($$GET1^DIQ(344.31,EFTIEN_",",.07,"E"),9)_" "
+48 SET XX=$EXTRACT(XX_$$SP,1,39)
+49 SET XX=XX_" FMS Doc Status: "_$PIECE(FMSDOC,"^",2)
+50 SET VALMHDR(4)=XX
+51 ; PRCA*4.5*321 - End of modified code block
+52 ;
+53 IF RCDPDATA(344,RCRECTDA,.08,"I")
Begin DoDot:1
+54 SET VALMSG="Receipt processed on "_RCDPDATA(344,RCRECTDA,.08,"E")
End DoDot:1
+55 QUIT
+56 ;
EXIT ;EP from ListMan Template RCDP RECEIPT PROFILE
+1 ; Exit option/clean up
+2 KILL ^TMP("RCDPRPLM",$JOB)
+3 QUIT
+4 ;
SP() ; extrinsic variable, 132 spaces
QUIT $JUSTIFY("",132)
+1 ;
