RCDPURE1 ;WISC/RFJ - Process a Receipt ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**114,148,153,169,204,173,214,217,296,298,304,321,367**;Mar 20, 1995;Build 11
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
PROCESS(RCRECTDA,RCSCREEN) ; process a receipt, update ar, generate cr/tr documents to fms
; the receipt and deposit must be locked before calling this label
; if $g(rcscreen) = 1 show messages during processing
; if $g(rcscreen) = 2 store messages during processing
;
N RCPAYDA,RCDPFPAY,RCERROR,RCMSG,RCEFT,RCERA,RCPAYDT0,RCPAYDT1,RCSUSPAR,RCI,RCJ,RCCMTFLG
K ^TMP($J,"RCDPEMSG"),^TMP("RCDPE-RECEIPT-ERROR",$J)
S RCCMTFLG=""
;
; === No comments === PRCA*4.5*304
; If there are entries in suspense with no comments, AND, posting manually, not through auto-posting, display the list of entries
I RCSCREEN=1 D Q:RCCMTFLG
. S RCSUSPAR="",RCPAYDA=0
. F S RCPAYDA=$O(^RCY(344,RCRECTDA,1,RCPAYDA)) Q:'RCPAYDA D
. . S RCPAYDT0=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
. . S RCPAYDT1=$G(^RCY(344,RCRECTDA,1,RCPAYDA,1))
. . ; If there is no Bill linked, and the pay amount is not 0 and there is no comment, add to the list
. . I $P(RCPAYDT0,U,9)="",($P(RCPAYDT0,U,4)'=0),($P(RCPAYDT1,U,2)="") S RCSUSPAR(RCPAYDA)=""
. ;
. S RCI="" I $O(RCSUSPAR(RCI)) D Q
. . I '$G(RCSCREEN) Q
. . S RCMSG="The following line items are in suspense: "
. . S RCJ="" F S RCJ=$O(RCSUSPAR(RCJ)) Q:'RCJ D
. . . S RCMSG=RCMSG_RCJ_","
. . S RCMSG=$E(RCMSG,1,$L(RCMSG)-1)
. . D MSG(RCMSG,RCSCREEN,"!!")
. . S RCMSG="Please add the appropriate comment(s) to these line items before re-processing this receipt."
. . D MSG(RCMSG,RCSCREEN,"!!")
. . S RCCMTFLG=1
;
; first mark the receipt as processed/closed to prevent changing the
; data if the receipt does not fully process. this will lock the
; cancel payment, edit payment, etc. options. once a receipt is
; processed, even partially, it should not be changed.
D MARKPROC^RCDPUREC(RCRECTDA,"")
;
; Special processing needed for EFT-related receipts
; RCEFT = 1 if EFT deposit, = 2 if receipt detail transfer, 0 if no EFT
S RCEFT=+$$EDILB^RCDPEU(RCRECTDA)
S RCERA=$P($G(^RCY(344,RCRECTDA,0)),U,18)
;
; === no payments ===
; if there are no payments for the receipt, quit
I '$O(^RCY(344,RCRECTDA,1,0)) D Q
. I $G(RCSCREEN) S RCMSG="Receipt does not have any payments and has been marked as processed/closed." D MSG(RCMSG,RCSCREEN,"!!")
. S ^TMP("RCDPE-RECEIPT-ERROR",$J)=RCMSG ;prca*4.5*298 used by auto-post process
. I RCERA D UPDERA(RCERA)
;
; check to see if the payments have dollar amounts
S RCPAYDA=0 F S RCPAYDA=$O(^RCY(344,RCRECTDA,1,RCPAYDA)) Q:'RCPAYDA I $P($G(^(RCPAYDA,0)),"^",4) S RCDPFPAY=1 Q
I '$G(RCDPFPAY) D Q
. I $G(RCSCREEN) S RCMSG="Receipt does not have any payments and has been marked as processed/closed." D MSG(RCMSG,RCSCREEN,"!!")
. S ^TMP("RCDPE-RECEIPT-ERROR",$J)=RCMSG ;prca*4.5*298 used by auto-post process
. I RCERA D UPDERA(RCERA)
;
; === update AR accounts ===
I $G(RCSCREEN) S RCMSG="Updating AR accounts..." D MSG(RCMSG,RCSCREEN,"!!")
;
; loop payments and apply to account in AR
S RCPAYDA=0 F S RCPAYDA=$O(^RCY(344,RCRECTDA,1,RCPAYDA)) Q:'RCPAYDA D I RCERROR Q
. S RCERROR=$$PROCESS^RCBEPAY(RCRECTDA,RCPAYDA)
. S:RCERROR ^TMP("RCDPE-RECEIPT-ERROR",$J)=RCERROR ;prca*4.5*298 used by auto-post process
;
; an error occurred during processing a payment
I $G(RCERROR) D Q
. I '$G(RCSCREEN) Q
. S RCMSG="+-----------------------------------------------------------------------------+" D MSG(RCMSG,RCSCREEN,"!!")
. S RCMSG="| An ERROR has occurred when processing payment "_RCPAYDA_" on receipt "_$P(^RCY(344,RCRECTDA,0),"^")_".",RCMSG=$E(RCMSG_$J("",77),1,77)_"|" D MSG(RCMSG,RCSCREEN,"!")
. S RCMSG="| The error message returned during processing is:",RCMSG=$E(RCMSG_$J("",77),1,77)_"|" D MSG(RCMSG,RCSCREEN,"!")
. S RCMSG="|"_$J("",77)_"|" D MSG(RCMSG,RCSCREEN,"!")
. S RCMSG=$E("| "_$P(RCERROR,"^",2)_$J("",77),1,77)_"|" D MSG(RCMSG,RCSCREEN,"!")
. S RCMSG="|"_$J("",77)_"|" D MSG(RCMSG,RCSCREEN,"!")
. S RCMSG=$E("| You will need to correct the error before you can completely process the"_$J("",77),1,77)_"|" D MSG(RCMSG,RCSCREEN,"!")
. S RCMSG=$E("| receipt. Once the receipt is completely processed, the FMS "_$S(RCEFT'=2:"Cash Receipt",1:"'TR'")_$J("",77),1,77)_"|" D MSG(RCMSG,RCSCREEN,"!")
. S RCMSG=$E("| document will be generated."_$J("",77),1,77)_"|" D MSG(RCMSG,RCSCREEN,"!")
. S RCMSG="+-----------------------------------------------------------------------------+" D MSG(RCMSG,RCSCREEN,"!")
;
; all payments processed correctly
I RCERA D UPDERA(RCERA)
I $G(RCSCREEN) D MSG(" Done.",RCSCREEN)
;
; *296 - no cr document for event type 'a' or 'p' or 't'
N RCDPETY S RCDPETY=$P($G(^RCY(344,RCRECTDA,0)),"^",4)
I (RCDPETY=15)!(RCDPETY=16)!(RCDPETY=13) D 215 Q
;
; if no deposit ticket and not related to EFT or is a HAC payment, do not send to fms
I '$P(^RCY(344,RCRECTDA,0),"^",6),$S('RCEFT:1,1:$$HACEFT^RCDPEU(+$P(^RCY(344,RCRECTDA,0),U,17))) D Q
. D 215
. I $G(RCSCREEN) S RCMSG="Receipt does not have a deposit ticket and will NOT be sent to FMS." D MSG(RCMSG,RCSCREEN,"!!")
. S ^TMP("RCDPE-RECEIPT-ERROR",$J)="" ;prca*4.5*298 used by auto-post process
;
; === send fms cash receipt document ===
N GECSDATA,FMSDOCNO,RESULT,REFMS
; lookup fms document number to see if the receipt has been
; sent to fms (field 200 in file 344)
S FMSDOCNO=$P($G(^RCY(344,RCRECTDA,2)),"^")
; if there is an entry, find the code sheet in gcs to rebuild
; gecsdata will be the ien for file 2100.1
I FMSDOCNO'="" S REFMS=1 N DIQ2 D DATA^GECSSGET(FMSDOCNO,0)
;
I $G(RCSCREEN)&$G(GECSDATA) S RCMSG="Re-Transmitting CR document to FMS... " D MSG(RCMSG,RCSCREEN,"!!")
I $G(RCSCREEN)&'$G(GECSDATA) S RCMSG="Transmitting CR document to FMS... " D MSG(RCMSG,RCSCREEN,"!!")
;
; build and send the tr/cr document to fms
I RCEFT'=2 D ; Send CR doc
. S RESULT=$$BUILDCR^RCXFMSCR(RCRECTDA,+$G(GECSDATA),RCEFT)
E D ; Send TR doc
. S RESULT=$$GETTR^RCXFMST1(RCRECTDA,+$G(GECSDATA))
; error in building code sheet
I 'RESULT D:$G(RCSCREEN) MSG("ERROR - "_$P(RESULT,"^",2),RCSCREEN,"!!") Q
;
; no document to send
I $P(RESULT,"^")=-1,$G(RCSCREEN) S RCMSG="NOTE - "_$P(RESULT,"^",2) S $P(RESULT,"^",2)="" D MSG(RCMSG,RCSCREEN,"!!") S ^TMP("RCDPE-RECEIPT-ERROR",$J)=""
; document built and sent
I $P(RESULT,"^")=1,$G(RCSCREEN) D
. N Z,DIE,DR,DA
. D MSG("Done. FMS document number "_$P(RESULT,"^",2),RCSCREEN,"!!")
. I +$O(^RCY(344.4,"ARCT",RCRECTDA,0)) S DIE="^RCY(344.4,",DR=".14////1",DA=+$O(^RCY(344.4,"ARCT",RCRECTDA,0)) D ^DIE
. I $P($G(^RCY(344,RCRECTDA,0)),U,17) S Z=$P($G(^RCY(344.31,+$P(^RCY(344,RCRECTDA,0),U,17),0)),U,15) I Z'="" S DA=RCRECTDA,DIE="^RCY(344,",DR=".16////"_Z D ^DIE
I $G(RCSCREEN) D
. N Y
. I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !! S RCMSG=" * * * * Transmission will be held until "_Y_" * * * *" D MSG(RCMSG,RCSCREEN,"!!")
;
;
; store the fms document number (receipt already marked processed/
; closed at the top of the routine just before posting the dollars.
D MARKPROC^RCDPUREC(RCRECTDA,$P(RESULT,"^",2))
I RCEFT=2 D MSG("No 215 report generated for this receipt",RCSCREEN,"!!") G Q215
;
;
215 ; === print 215 report ===
I $G(RCSCREEN) D MSG("Queuing 215 report...",RCSCREEN,"!!")
N DEVICE
S DEVICE=$$OPTCK^RCDPRPL2("215REPORT",3)
I DEVICE="" D:$G(RCSCREEN) MSG(" Use Customize Option to set up the default printer.",RCSCREEN) Q
;
S ZTIO=DEVICE,ZTDTH=$H,ZTRTN="DQ^RCDPR215",ZTSAVE("RECEIPDA")=RCRECTDA,ZTSAVE("RCTYPE")="A"
D ^%ZTLOAD,^%ZISC
Q215 I $G(RCSCREEN) D MSG(" Done.",RCSCREEN)
Q
;
UPDERA(RCERA) ; Update detail posted status for ERA entry RCERA
;
N DA,DIE,DR
S DA=+$G(RCERA),DR=".14////1",DIE="^RCY(344.4," D:DA ^DIE
Q
;
MSG(RCMSG,RCSCREEN,PRELINE,POSTLINE) ; Write message or set into msg array
; RCMSG = text to write RCSCREEN = screen flag
; PRELINE = the line feeds to print before the text
; POSTLINE = the line feeds to print after the text
Q:'RCSCREEN
N RCPRE,RCPOST,Z
S RCPRE=$L($G(PRELINE),"!")-1,RCPOST=$L($G(POSTLINE),"!")-1
I RCSCREEN=1 D G MSGQ
. F Z=1:1:RCPRE W !
. W RCMSG
. F Z=1:1:RCPOST W !
F Z=1:1:RCPRE S ^TMP($J,"RCDPEMSG",+$O(^TMP("RCDPEMSG",""),-1)+1)=""
S ^TMP($J,"RCDPEMSG",+$O(^TMP("RCDPEMSG",""),-1)+1)=RCMSG
F Z=1:1:RCPOST S ^TMP($J,"RCDPEMSG",+$O(^TMP("RCDPEMSG",""),-1)+1)=""
MSGQ Q
;
; PRCA*4.5*298 updated EDIT4 removing DIPA
EDIT4(DA,DR,RCDR1,RCDR2,RCDR3) ; Modify DR string for type of payment edit
; for EDI Lockbox
; Input: DA,DR Output: RCDR1,RCDR2,RCDR3
; If type unchanged, or neither old/new are EDI Lockbox, no chk needed
; If old type is EDI Lockbox and scratch pad exists, no change allowed
; If changed to EDI Lockbox and detail already exists, no chg allowed without UNMATCH EFT key
; If changed to EDI Lockbox, ask for related EFT
N RCDR,RCLST,RCM,RCM1,RCM2,RCM3,RCN4,RCNE,RCNO,RCO4,RCOE,RCP,RCSTRT,Z,Z0
S (RCDR1,RCDR2,RCDR3)=""
;
S RCP=10 F Z=2:1 Q:DR'[("@"_RCP)&(DR'[("@"_(RCP+1)))&(DR'[("@"_(RCP+2)))&(DR'[("@"_(RCP+3)))&(DR'[("@"_(RCP+4))) S RCP=RCP*Z
;
S Z=$L(DR,".04;"),RCSTRT=1,RCLST=Z
I Z>2 D ; Find .04, not n.04
. F S Z0=$P(DR,".04;",RCSTRT) Q:Z0=""!'$E(Z0,$L(Z0)) S RCSTRT=RCSTRT+1
;
; If unchanged/changed from/to other than EDI Lockbox, jump over edits
S RCDR1="S RCP="_RCP_" D SETV^RCDPURE1;"_$P(DR,".04;",1,RCSTRT)
S RCDR2="@"_RCP_";.04;S RCNO=0,RCN4=X D TYP^RCDPUREC(.Y);.17////^S X=RCNE;S Y=""@"_(RCP+2)_""""
; Reset field .04 and .17 if not a valid type change
S RCDR2=RCDR2_";@"_(RCP+1)_";.04////^S X=RCO4;I RCOE="""" S Y=""@"_(RCP+3)_""";"
S RCDR2=RCDR2_".17////^S X=RCOE;@"_(RCP+3)_";"
; PRCA*4.5*321 Modified error message logic in $S ; PRCA*4.5*367 - Added RECEIPT TOTAL if type is CHAMPVA
S RCDR2=RCDR2_"W !,*7,$S(RCN4=14&RCNO:RCM2,RCO4=14:RCM1,1:RCM),! S Y=""@"_RCP_""";@"_(RCP+4)_";.06///@;.22;S Y=""@99"";@"_(RCP+2)
S RCDR3=$P(DR,".04;",RCSTRT+1,RCLST)
Q
;
; PRCA*4.5*298 updated SETV removing DIPA, added comments
SETV ; Set up variables needed to edit change of receipt type, used in DR strings to edit AR BATCH PAYMENT (#344)
; RCO4 = existing (#.04) TYPE OF PAYMENT value, RCOE = existing (#.17) EFT RECORD value
N X S X=$G(^RCY(344,DA,0)),RCO4=$P(X,U,4),RCOE=$P(X,U,17)
S RCM="RCDPEPP key required for this action" ; PCRA*4.5*321
S RCM1="RCDPEPP key required once detail has been loaded from the ERA" ; PCRA*4.5*321
S RCM2="Must have an EFT for an EDI Lockbox payment type"
S RCM3=">>If receipt is for an ERA and a paper check, select the ERA now"
Q
;
WL(DA) ; Function returns 0 if the worklist did not create the receipt
; or the ien of the worklist entry if it did (344.4 and 344.49 are DINUMED)
N Z
S Z=+$O(^RCY(344.4,"AREC",DA,0))
Q Z
;
HAC(RC) ; Returns 1 if the receipt in RC is related to a HAC EFT
N Z,HAC
S HAC=0
; ERA related to an EFT detail record
S Z=+$G(^RCY(344.31,+$P($G(^RCY(344,RC,0)),U,17),0))
; Deposit # in EFT transmission starts with HAC
I Z S Z=$P($G(^RCY(344.3,+Z,0)),U,6) I $E(Z,1,3)="HAC" S HAC=1
Q HAC
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPURE1 11411 printed Sep 23, 2025@19:22:43 Page 2
RCDPURE1 ;WISC/RFJ - Process a Receipt ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**114,148,153,169,204,173,214,217,296,298,304,321,367**;Mar 20, 1995;Build 11
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
PROCESS(RCRECTDA,RCSCREEN) ; process a receipt, update ar, generate cr/tr documents to fms
+1 ; the receipt and deposit must be locked before calling this label
+2 ; if $g(rcscreen) = 1 show messages during processing
+3 ; if $g(rcscreen) = 2 store messages during processing
+4 ;
+5 NEW RCPAYDA,RCDPFPAY,RCERROR,RCMSG,RCEFT,RCERA,RCPAYDT0,RCPAYDT1,RCSUSPAR,RCI,RCJ,RCCMTFLG
+6 KILL ^TMP($JOB,"RCDPEMSG"),^TMP("RCDPE-RECEIPT-ERROR",$JOB)
+7 SET RCCMTFLG=""
+8 ;
+9 ; === No comments === PRCA*4.5*304
+10 ; If there are entries in suspense with no comments, AND, posting manually, not through auto-posting, display the list of entries
+11 IF RCSCREEN=1
Begin DoDot:1
+12 SET RCSUSPAR=""
SET RCPAYDA=0
+13 FOR
SET RCPAYDA=$ORDER(^RCY(344,RCRECTDA,1,RCPAYDA))
if 'RCPAYDA
QUIT
Begin DoDot:2
+14 SET RCPAYDT0=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,0))
+15 SET RCPAYDT1=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,1))
+16 ; If there is no Bill linked, and the pay amount is not 0 and there is no comment, add to the list
+17 IF $PIECE(RCPAYDT0,U,9)=""
IF ($PIECE(RCPAYDT0,U,4)'=0)
IF ($PIECE(RCPAYDT1,U,2)="")
SET RCSUSPAR(RCPAYDA)=""
End DoDot:2
+18 ;
+19 SET RCI=""
IF $ORDER(RCSUSPAR(RCI))
Begin DoDot:2
+20 IF '$GET(RCSCREEN)
QUIT
+21 SET RCMSG="The following line items are in suspense: "
+22 SET RCJ=""
FOR
SET RCJ=$ORDER(RCSUSPAR(RCJ))
if 'RCJ
QUIT
Begin DoDot:3
+23 SET RCMSG=RCMSG_RCJ_","
End DoDot:3
+24 SET RCMSG=$EXTRACT(RCMSG,1,$LENGTH(RCMSG)-1)
+25 DO MSG(RCMSG,RCSCREEN,"!!")
+26 SET RCMSG="Please add the appropriate comment(s) to these line items before re-processing this receipt."
+27 DO MSG(RCMSG,RCSCREEN,"!!")
+28 SET RCCMTFLG=1
End DoDot:2
QUIT
End DoDot:1
if RCCMTFLG
QUIT
+29 ;
+30 ; first mark the receipt as processed/closed to prevent changing the
+31 ; data if the receipt does not fully process. this will lock the
+32 ; cancel payment, edit payment, etc. options. once a receipt is
+33 ; processed, even partially, it should not be changed.
+34 DO MARKPROC^RCDPUREC(RCRECTDA,"")
+35 ;
+36 ; Special processing needed for EFT-related receipts
+37 ; RCEFT = 1 if EFT deposit, = 2 if receipt detail transfer, 0 if no EFT
+38 SET RCEFT=+$$EDILB^RCDPEU(RCRECTDA)
+39 SET RCERA=$PIECE($GET(^RCY(344,RCRECTDA,0)),U,18)
+40 ;
+41 ; === no payments ===
+42 ; if there are no payments for the receipt, quit
+43 IF '$ORDER(^RCY(344,RCRECTDA,1,0))
Begin DoDot:1
+44 IF $GET(RCSCREEN)
SET RCMSG="Receipt does not have any payments and has been marked as processed/closed."
DO MSG(RCMSG,RCSCREEN,"!!")
+45 ;prca*4.5*298 used by auto-post process
SET ^TMP("RCDPE-RECEIPT-ERROR",$JOB)=RCMSG
+46 IF RCERA
DO UPDERA(RCERA)
End DoDot:1
QUIT
+47 ;
+48 ; check to see if the payments have dollar amounts
+49 SET RCPAYDA=0
FOR
SET RCPAYDA=$ORDER(^RCY(344,RCRECTDA,1,RCPAYDA))
if 'RCPAYDA
QUIT
IF $PIECE($GET(^(RCPAYDA,0)),"^",4)
SET RCDPFPAY=1
QUIT
+50 IF '$GET(RCDPFPAY)
Begin DoDot:1
+51 IF $GET(RCSCREEN)
SET RCMSG="Receipt does not have any payments and has been marked as processed/closed."
DO MSG(RCMSG,RCSCREEN,"!!")
+52 ;prca*4.5*298 used by auto-post process
SET ^TMP("RCDPE-RECEIPT-ERROR",$JOB)=RCMSG
+53 IF RCERA
DO UPDERA(RCERA)
End DoDot:1
QUIT
+54 ;
+55 ; === update AR accounts ===
+56 IF $GET(RCSCREEN)
SET RCMSG="Updating AR accounts..."
DO MSG(RCMSG,RCSCREEN,"!!")
+57 ;
+58 ; loop payments and apply to account in AR
+59 SET RCPAYDA=0
FOR
SET RCPAYDA=$ORDER(^RCY(344,RCRECTDA,1,RCPAYDA))
if 'RCPAYDA
QUIT
Begin DoDot:1
+60 SET RCERROR=$$PROCESS^RCBEPAY(RCRECTDA,RCPAYDA)
+61 ;prca*4.5*298 used by auto-post process
if RCERROR
SET ^TMP("RCDPE-RECEIPT-ERROR",$JOB)=RCERROR
End DoDot:1
IF RCERROR
QUIT
+62 ;
+63 ; an error occurred during processing a payment
+64 IF $GET(RCERROR)
Begin DoDot:1
+65 IF '$GET(RCSCREEN)
QUIT
+66 SET RCMSG="+-----------------------------------------------------------------------------+"
DO MSG(RCMSG,RCSCREEN,"!!")
+67 SET RCMSG="| An ERROR has occurred when processing payment "_RCPAYDA_" on receipt "_$PIECE(^RCY(344,RCRECTDA,0),"^")_"."
SET RCMSG=$EXTRACT(RCMSG_$JUSTIFY("",77),1,77)_"|"
DO MSG(RCMSG,RCSCREEN,"!")
+68 SET RCMSG="| The error message returned during processing is:"
SET RCMSG=$EXTRACT(RCMSG_$JUSTIFY("",77),1,77)_"|"
DO MSG(RCMSG,RCSCREEN,"!")
+69 SET RCMSG="|"_$JUSTIFY("",77)_"|"
DO MSG(RCMSG,RCSCREEN,"!")
+70 SET RCMSG=$EXTRACT("| "_$PIECE(RCERROR,"^",2)_$JUSTIFY("",77),1,77)_"|"
DO MSG(RCMSG,RCSCREEN,"!")
+71 SET RCMSG="|"_$JUSTIFY("",77)_"|"
DO MSG(RCMSG,RCSCREEN,"!")
+72 SET RCMSG=$EXTRACT("| You will need to correct the error before you can completely process the"_$JUSTIFY("",77),1,77)_"|"
DO MSG(RCMSG,RCSCREEN,"!")
+73 SET RCMSG=$EXTRACT("| receipt. Once the receipt is completely processed, the FMS "_$SELECT(RCEFT'=2:"Cash Receipt",1:"'TR'")_$JUSTIFY("",77),1,77)_"|"
DO MSG(RCMSG,RCSCREEN,"!")
+74 SET RCMSG=$EXTRACT("| document will be generated."_$JUSTIFY("",77),1,77)_"|"
DO MSG(RCMSG,RCSCREEN,"!")
+75 SET RCMSG="+-----------------------------------------------------------------------------+"
DO MSG(RCMSG,RCSCREEN,"!")
End DoDot:1
QUIT
+76 ;
+77 ; all payments processed correctly
+78 IF RCERA
DO UPDERA(RCERA)
+79 IF $GET(RCSCREEN)
DO MSG(" Done.",RCSCREEN)
+80 ;
+81 ; *296 - no cr document for event type 'a' or 'p' or 't'
+82 NEW RCDPETY
SET RCDPETY=$PIECE($GET(^RCY(344,RCRECTDA,0)),"^",4)
+83 IF (RCDPETY=15)!(RCDPETY=16)!(RCDPETY=13)
DO 215
QUIT
+84 ;
+85 ; if no deposit ticket and not related to EFT or is a HAC payment, do not send to fms
+86 IF '$PIECE(^RCY(344,RCRECTDA,0),"^",6)
IF $SELECT('RCEFT:1,1:$$HACEFT^RCDPEU(+$PIECE(^RCY(344,RCRECTDA,0),U,17)))
Begin DoDot:1
+87 DO 215
+88 IF $GET(RCSCREEN)
SET RCMSG="Receipt does not have a deposit ticket and will NOT be sent to FMS."
DO MSG(RCMSG,RCSCREEN,"!!")
+89 ;prca*4.5*298 used by auto-post process
SET ^TMP("RCDPE-RECEIPT-ERROR",$JOB)=""
End DoDot:1
QUIT
+90 ;
+91 ; === send fms cash receipt document ===
+92 NEW GECSDATA,FMSDOCNO,RESULT,REFMS
+93 ; lookup fms document number to see if the receipt has been
+94 ; sent to fms (field 200 in file 344)
+95 SET FMSDOCNO=$PIECE($GET(^RCY(344,RCRECTDA,2)),"^")
+96 ; if there is an entry, find the code sheet in gcs to rebuild
+97 ; gecsdata will be the ien for file 2100.1
+98 IF FMSDOCNO'=""
SET REFMS=1
NEW DIQ2
DO DATA^GECSSGET(FMSDOCNO,0)
+99 ;
+100 IF $GET(RCSCREEN)&$GET(GECSDATA)
SET RCMSG="Re-Transmitting CR document to FMS... "
DO MSG(RCMSG,RCSCREEN,"!!")
+101 IF $GET(RCSCREEN)&'$GET(GECSDATA)
SET RCMSG="Transmitting CR document to FMS... "
DO MSG(RCMSG,RCSCREEN,"!!")
+102 ;
+103 ; build and send the tr/cr document to fms
+104 ; Send CR doc
IF RCEFT'=2
Begin DoDot:1
+105 SET RESULT=$$BUILDCR^RCXFMSCR(RCRECTDA,+$GET(GECSDATA),RCEFT)
End DoDot:1
+106 ; Send TR doc
IF '$TEST
Begin DoDot:1
+107 SET RESULT=$$GETTR^RCXFMST1(RCRECTDA,+$GET(GECSDATA))
End DoDot:1
+108 ; error in building code sheet
+109 IF 'RESULT
if $GET(RCSCREEN)
DO MSG("ERROR - "_$PIECE(RESULT,"^",2),RCSCREEN,"!!")
QUIT
+110 ;
+111 ; no document to send
+112 IF $PIECE(RESULT,"^")=-1
IF $GET(RCSCREEN)
SET RCMSG="NOTE - "_$PIECE(RESULT,"^",2)
SET $PIECE(RESULT,"^",2)=""
DO MSG(RCMSG,RCSCREEN,"!!")
SET ^TMP("RCDPE-RECEIPT-ERROR",$JOB)=""
+113 ; document built and sent
+114 IF $PIECE(RESULT,"^")=1
IF $GET(RCSCREEN)
Begin DoDot:1
+115 NEW Z,DIE,DR,DA
+116 DO MSG("Done. FMS document number "_$PIECE(RESULT,"^",2),RCSCREEN,"!!")
+117 IF +$ORDER(^RCY(344.4,"ARCT",RCRECTDA,0))
SET DIE="^RCY(344.4,"
SET DR=".14////1"
SET DA=+$ORDER(^RCY(344.4,"ARCT",RCRECTDA,0))
DO ^DIE
+118 IF $PIECE($GET(^RCY(344,RCRECTDA,0)),U,17)
SET Z=$PIECE($GET(^RCY(344.31,+$PIECE(^RCY(344,RCRECTDA,0),U,17),0)),U,15)
IF Z'=""
SET DA=RCRECTDA
SET DIE="^RCY(344,"
SET DR=".16////"_Z
DO ^DIE
End DoDot:1
+119 IF $GET(RCSCREEN)
Begin DoDot:1
+120 NEW Y
+121 IF '$GET(REFMS)&(DT>$$LDATE^RCRJR(DT))
SET Y=$EXTRACT($$FPS^RCAMFN01(DT,1),1,5)_"01"
DO DD^%DT
WRITE !!
SET RCMSG=" * * * * Transmission will be held until "_Y_" * * * *"
DO MSG(RCMSG,RCSCREEN,"!!")
End DoDot:1
+122 ;
+123 ;
+124 ; store the fms document number (receipt already marked processed/
+125 ; closed at the top of the routine just before posting the dollars.
+126 DO MARKPROC^RCDPUREC(RCRECTDA,$PIECE(RESULT,"^",2))
+127 IF RCEFT=2
DO MSG("No 215 report generated for this receipt",RCSCREEN,"!!")
GOTO Q215
+128 ;
+129 ;
215 ; === print 215 report ===
+1 IF $GET(RCSCREEN)
DO MSG("Queuing 215 report...",RCSCREEN,"!!")
+2 NEW DEVICE
+3 SET DEVICE=$$OPTCK^RCDPRPL2("215REPORT",3)
+4 IF DEVICE=""
if $GET(RCSCREEN)
DO MSG(" Use Customize Option to set up the default printer.",RCSCREEN)
QUIT
+5 ;
+6 SET ZTIO=DEVICE
SET ZTDTH=$HOROLOG
SET ZTRTN="DQ^RCDPR215"
SET ZTSAVE("RECEIPDA")=RCRECTDA
SET ZTSAVE("RCTYPE")="A"
+7 DO ^%ZTLOAD
DO ^%ZISC
Q215 IF $GET(RCSCREEN)
DO MSG(" Done.",RCSCREEN)
+1 QUIT
+2 ;
UPDERA(RCERA) ; Update detail posted status for ERA entry RCERA
+1 ;
+2 NEW DA,DIE,DR
+3 SET DA=+$GET(RCERA)
SET DR=".14////1"
SET DIE="^RCY(344.4,"
if DA
DO ^DIE
+4 QUIT
+5 ;
MSG(RCMSG,RCSCREEN,PRELINE,POSTLINE) ; Write message or set into msg array
+1 ; RCMSG = text to write RCSCREEN = screen flag
+2 ; PRELINE = the line feeds to print before the text
+3 ; POSTLINE = the line feeds to print after the text
+4 if 'RCSCREEN
QUIT
+5 NEW RCPRE,RCPOST,Z
+6 SET RCPRE=$LENGTH($GET(PRELINE),"!")-1
SET RCPOST=$LENGTH($GET(POSTLINE),"!")-1
+7 IF RCSCREEN=1
Begin DoDot:1
+8 FOR Z=1:1:RCPRE
WRITE !
+9 WRITE RCMSG
+10 FOR Z=1:1:RCPOST
WRITE !
End DoDot:1
GOTO MSGQ
+11 FOR Z=1:1:RCPRE
SET ^TMP($JOB,"RCDPEMSG",+$ORDER(^TMP("RCDPEMSG",""),-1)+1)=""
+12 SET ^TMP($JOB,"RCDPEMSG",+$ORDER(^TMP("RCDPEMSG",""),-1)+1)=RCMSG
+13 FOR Z=1:1:RCPOST
SET ^TMP($JOB,"RCDPEMSG",+$ORDER(^TMP("RCDPEMSG",""),-1)+1)=""
MSGQ QUIT
+1 ;
+2 ; PRCA*4.5*298 updated EDIT4 removing DIPA
EDIT4(DA,DR,RCDR1,RCDR2,RCDR3) ; Modify DR string for type of payment edit
+1 ; for EDI Lockbox
+2 ; Input: DA,DR Output: RCDR1,RCDR2,RCDR3
+3 ; If type unchanged, or neither old/new are EDI Lockbox, no chk needed
+4 ; If old type is EDI Lockbox and scratch pad exists, no change allowed
+5 ; If changed to EDI Lockbox and detail already exists, no chg allowed without UNMATCH EFT key
+6 ; If changed to EDI Lockbox, ask for related EFT
+7 NEW RCDR,RCLST,RCM,RCM1,RCM2,RCM3,RCN4,RCNE,RCNO,RCO4,RCOE,RCP,RCSTRT,Z,Z0
+8 SET (RCDR1,RCDR2,RCDR3)=""
+9 ;
+10 SET RCP=10
FOR Z=2:1
if DR'[("@"_RCP)&(DR'[("@"_(RCP+1)))&(DR'[("@"_(RCP+2)))&(DR'[("@"_(RCP+3)))&(DR'[("@"_(RCP+4)))
QUIT
SET RCP=RCP*Z
+11 ;
+12 SET Z=$LENGTH(DR,".04;")
SET RCSTRT=1
SET RCLST=Z
+13 ; Find .04, not n.04
IF Z>2
Begin DoDot:1
+14 FOR
SET Z0=$PIECE(DR,".04;",RCSTRT)
if Z0=""!'$EXTRACT(Z0,$LENGTH(Z0))
QUIT
SET RCSTRT=RCSTRT+1
End DoDot:1
+15 ;
+16 ; If unchanged/changed from/to other than EDI Lockbox, jump over edits
+17 SET RCDR1="S RCP="_RCP_" D SETV^RCDPURE1;"_$PIECE(DR,".04;",1,RCSTRT)
+18 SET RCDR2="@"_RCP_";.04;S RCNO=0,RCN4=X D TYP^RCDPUREC(.Y);.17////^S X=RCNE;S Y=""@"_(RCP+2)_""""
+19 ; Reset field .04 and .17 if not a valid type change
+20 SET RCDR2=RCDR2_";@"_(RCP+1)_";.04////^S X=RCO4;I RCOE="""" S Y=""@"_(RCP+3)_""";"
+21 SET RCDR2=RCDR2_".17////^S X=RCOE;@"_(RCP+3)_";"
+22 ; PRCA*4.5*321 Modified error message logic in $S ; PRCA*4.5*367 - Added RECEIPT TOTAL if type is CHAMPVA
+23 SET RCDR2=RCDR2_"W !,*7,$S(RCN4=14&RCNO:RCM2,RCO4=14:RCM1,1:RCM),! S Y=""@"_RCP_""";@"_(RCP+4)_";.06///@;.22;S Y=""@99"";@"_(RCP+2)
+24 SET RCDR3=$PIECE(DR,".04;",RCSTRT+1,RCLST)
+25 QUIT
+26 ;
+27 ; PRCA*4.5*298 updated SETV removing DIPA, added comments
SETV ; Set up variables needed to edit change of receipt type, used in DR strings to edit AR BATCH PAYMENT (#344)
+1 ; RCO4 = existing (#.04) TYPE OF PAYMENT value, RCOE = existing (#.17) EFT RECORD value
+2 NEW X
SET X=$GET(^RCY(344,DA,0))
SET RCO4=$PIECE(X,U,4)
SET RCOE=$PIECE(X,U,17)
+3 ; PCRA*4.5*321
SET RCM="RCDPEPP key required for this action"
+4 ; PCRA*4.5*321
SET RCM1="RCDPEPP key required once detail has been loaded from the ERA"
+5 SET RCM2="Must have an EFT for an EDI Lockbox payment type"
+6 SET RCM3=">>If receipt is for an ERA and a paper check, select the ERA now"
+7 QUIT
+8 ;
WL(DA) ; Function returns 0 if the worklist did not create the receipt
+1 ; or the ien of the worklist entry if it did (344.4 and 344.49 are DINUMED)
+2 NEW Z
+3 SET Z=+$ORDER(^RCY(344.4,"AREC",DA,0))
+4 QUIT Z
+5 ;
HAC(RC) ; Returns 1 if the receipt in RC is related to a HAC EFT
+1 NEW Z,HAC
+2 SET HAC=0
+3 ; ERA related to an EFT detail record
+4 SET Z=+$GET(^RCY(344.31,+$PIECE($GET(^RCY(344,RC,0)),U,17),0))
+5 ; Deposit # in EFT transmission starts with HAC
+6 IF Z
SET Z=$PIECE($GET(^RCY(344.3,+Z,0)),U,6)
IF $EXTRACT(Z,1,3)="HAC"
SET HAC=1
+7 QUIT HAC
+8 ;
