- 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 Jan 18, 2025@02:47:48 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 ;