RCDPEDAR ;ALB/TMK - ACTIVITY REPORT ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,276,284,283,298,304,318,321,326,432,439**;Mar 20, 1995;Build 29
;Per VA Directive 6402, this routine should not be modified.
Q
;
RPT ; Daily Activity Rpt On Demand
N POP,RCDET,RCDIV,RCDONLY,RCDT1,RCDT2,RCEXCEL,RCEXSTOP,RCHDR,RCINC,RCLSTMGR,RCNJ ;PRCA*4.5*439
N RCPAR,RCPAY,RCPYRSEL,RCRANGE,RCSTOP,RCTMPND,RCTYPE,RCUNBAL,VAUTD,X,XX,Y,%ZIS
S RCNJ=0 ; Not the nightly job, user interactions
D DIVISION^VAUTOMA ; IA 664 Select Division/Station - sets VAUTD
I 'VAUTD,($D(VAUTD)'=11) Q
S RCDET=$$RTYPE^RCDPEDA4() ; Select Report Type (Summary/Detail)
Q:RCDET=-1
S XX=$$DTRANGE^RCDPEDA4(.RCDT1,.RCDT2) ; Select Date Range to be used
Q:'XX
;
; PRCA*4.5*326 - Ask to show Medical/Pharmacy Tricare CHAMPVA or All
S RCTYPE=$$RTYPE^RCDPEU1("")
I RCTYPE<0 Q
;
S RCPAY=$$PAYRNG^RCDPEU1() ; PRCA*4.5*326 - Selected or Range of Payers
Q:RCPAY=-1 ; PRCA*4.5*326 '^' or timeout
;
I RCPAY'="A" D Q:XX=-1 ; PRCA*4.5*326 - Since we don't want all payers
. S RCPAR("SELC")=RCPAY ; prompt for payers we do want
. S RCPAR("TYPE")=RCTYPE
. S RCPAR("FILE")=344.4
. S RCPAR("DICA")="Select Insurance Company NAME: "
. S XX=$$SELPAY^RCDPEU1(.RCPAR)
;
S RCDONLY=$$DBTONLY^RCDPEDA4() ; Debit only filter ;PRCA*4.5*321
Q:RCDONLY=-1 ; '^' or timeout
;
S RCUNBAL=$$UNBALONLY^RCDPEDA4() ; Unbalanced only filter ;Add new filter, PRCA*4.5*439
Q:RCUNBAL=-1 ; '^' or timeout
;
; PRCA*4.5*439 Add Excel, begin
; if user selected detail report (RCDET=1), offer option of Excel format
S RCEXCEL=0,RCEXSTOP=0 I RCDET D Q:RCEXSTOP
. S RCEXCEL=$$DISPTY^RCDPEM3() I RCEXCEL<0 S RCEXSTOP=1 Q
. ; display device info about Excel format, set ListMan flag to prevent question
. I RCEXCEL S RCLSTMGR="^" D INFO^RCDPEM6
. I $D(DUOUT)!$D(DTOUT) S RCEXSTOP=1 Q
;
; if not output to Excel ask for ListMan display, quit if timeout or "^"
S RCLSTMGR=0 I 'RCEXCEL S RCLSTMGR=$$ASKLM^RCDPEARL Q:RCLSTMGR<0
; PRCA*4.5*439 Add Excel, end
;
I RCLSTMGR=1 D Q ; ListMan Template format, put in array
. S RCTMPND="RCDPE_DAR"
. K ^TMP($J,RCTMPND)
. D EN(RCDET,RCDT1,RCDT2,RCLSTMGR,RCDONLY,0,RCUNBAL) ; PRCA*4.5*439 RCUNBAL
. D LMHDR^RCDPEDA4(.RCSTOP,RCDET,1,RCDT1,RCDT2,.RCHDR,RCDONLY)
. D LMRPT^RCDPEARL(.RCHDR,$NA(^TMP($J,RCTMPND))) ; Generate ListMan display
. K ^TMP($J,RCTMPND)
;
; Ask device
S %ZIS="QM"
D ^%ZIS
Q:POP
;
I $D(IO("Q")) D Q ; Queued Report
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK
. S ZTRTN="EN^RCDPEDAR("_RCDET_","_RCDT1_","_RCDT2_",0,"_RCDONLY_",0,"_RCUNBAL_")" ;PRCA*4.5*321 added RCDONLY ;PRCA*4.5*439 added RCUNBAL
. S ZTDESC="AR - EDI LOCKBOX EFT DAILY ACTIVITY REPORT"
. S ZTSAVE("RC*")="",ZTSAVE("VAUTD")=""
. S ZTSAVE("^TMP(""RCDPEU1"",$J,")="" ; PRCA*4.5*326
. ;
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
. K ZTSK,IO("Q")
. D HOME^%ZIS
;
U IO
D EN(RCDET,RCDT1,RCDT2,RCLSTMGR,RCDONLY,RCEXCEL,RCUNBAL) ;PRCA*4.5*439 Add RCEXCEL, added RCUNBAL
Q
;
EN(RCDET,RCDT1,RCDT2,RCLSTMGR,DONLY,RCEXCEL,RCUNBAL) ; Entry point for report, might be queued
; Input: RCDET - 1 - Detail Report, 0 - Summary
; RCDT1 - Internal Fileman Start date
; RCDT2 - Internal Fileman End date
; RCLSTMGR - 1 display in list manager, 0 otherwise
; Optional, defaults to 0
; DONLY - 1 only display EFTs with a debit flag of 'D'
; 0 display all EFTs
; RCEXCEL - 1 display in Excel format, 0 otherwise ;PRCA*4.5*439 Add Excel
; Optional, defaults to 0
; RCUNBAL - A - All, B - Balanced, U - Unbalanced ; PRCA*4.5*439 Add Unbalanced/Balanced selection
; Optional, defaults to All
; RCPAY - A - All Payers selected
; - R - Range of Payers
; - S - Specific payers
; RCPYRSEL - Array of selected payers (Only present if A1=3 above
; VAUTD - 1 - All selected divisions OR an array of selected divisions
N DFLG,DTADD,IEN3443,IEN34431,INPUT,RCDBAL,RCDBALOK,RCFLG,RCJOB,RCT,XX,Z ; PRCA*4.5*321 Added DFLG ; PRCA*4.5*439 Added RCDBAL,RCDBALOK
N:$G(ZTSK) ZTSTOP ; Job was tasked, ZTSTOP = flag to stop
S:'$D(RCLSTMGR) RCLSTMGR=0
S:'$D(RCEXCEL) RCEXCEL=0 ;PRCA*4.5*439 Add Excel
S:'$D(RCUNBAL) RCUNBAL="A" ;PRCA*4.5*439 Add Unbalanced/Balanced selection
S RCPAY=$G(RCPAY,"A") ; PRCA*4.5*326
;
S XX=$S(RCLSTMGR:1,1:0)
S INPUT=XX_"^"_RCLSTMGR_"^"_+RCDET
S RCJOB=$J
K ^TMP("RCDAILYACT",$J)
K ^TMP($J,"TOTALS") ; Initialize Totals temp workspace
;
; Loop through all of the EDI LOCKBOX DEPOSIT records in the selected date
; range and add any that pass the payer and division filters into ^TMP
; by the internal date added
S DTADD=RCDT1-.0001,RCT=0
S $P(INPUT,"^",4)=0 ; Current Page Number
S $P(INPUT,"^",5)=0 ; Stop Flag
S $P(INPUT,"^",10)=DONLY
S $P(INPUT,"^",11)=RCUNBAL ; User selection: A - All, B - Balanced, U - Unbalanced PRCA*4.5*439
F D Q:'DTADD Q:DTADD>(RCDT2_".9999") Q:$P(INPUT,"^",5)=1
. S DTADD=$O(^RCY(344.3,"ARECDT",DTADD))
. Q:'DTADD
. Q:DTADD>(RCDT2_".9999")
. S IEN3443=0
. F D Q:'IEN3443 Q:$P(INPUT,"^",5)=1
. . S IEN3443=$O(^RCY(344.3,"ARECDT",DTADD,IEN3443))
. . Q:'IEN3443
. . ;Add block of code to check for balanced or out of balance deposits PRCA*4.5*439
. . ;Check user's filter selection, match to balance state of deposit
. . ;Only check for balanced or not if user did not select 'A' for ALL.
. . I RCUNBAL'="A" S RCDBALOK=1 D I 'RCDBALOK Q ;If deposit balance/unbalance doesn't match user selection, quit to ignore this deposit.
. . . S RCDBAL=$$DEPBAL^RCDPEDA4(IEN3443) ;Check deposit balance. Compare to EFT totals. 1 if in balance, 0 if out of balance.
. . . ; If user selected unbalanced deposits in filter selection, skip balanced deposits by setting okay flag to zero (RCDBALOK).
. . . I RCUNBAL="U" S:RCDBAL RCDBALOK=0 Q
. . . ; If user selected balanced deposits in filter selection, skip unbalanced deposits by setting okay flag to zero (RCDBALOK).
. . . I RCUNBAL="B" S:'RCDBAL RCDBALOK=0 Q
. . S IEN34431="",RCFLG=0
. . F D Q:IEN34431=""
. . . S IEN34431=$O(^RCY(344.31,"B",IEN3443,IEN34431))
. . . Q:IEN34431=""
. . . ;
. . . I RCPAY'="A" D Q:'XX
. . . . S XX=$$ISSEL^RCDPEU1(344.31,IEN34431) ; PRCA*4.5*326 Check if payer was selected
. . . I RCTYPE'="A" D Q:'XX ; If all of a given type of payer selected
. . . . S XX=$$ISTYPE^RCDPEU1(344.31,IEN34431,RCTYPE) ; check that payer matches type
. . . ;
. . . Q:'$$CHKDIV(IEN34431,0,.VAUTD) ; Not a selected station/division
. . . ;
. . . ; PRCA*4.5*321 Added filter for Debit EFTs Only below
. . . I DONLY D Q:DFLG'="D" ; Not an EFT with a debit flag of 'D'
. . . . S DFLG=$$GET1^DIQ(344.31,IEN34431,3,"E")
. . . S RCFLG=1
. . . S ^TMP("RCDAILYACT",$J,DTADD\1,IEN3443,"EFT",IEN34431)=""
. . ;
. . S:RCFLG ^TMP("RCDAILYACT",$J,DTADD\1,IEN3443)=""
. . S RCT=RCT+1 ; Current Record Count
. . ;
. . ; Check for user stopped every 100 records
. . I '(RCT#100),$D(ZTQUEUED),$$S^%ZTLOAD D Q
. . . S ZTSTOP=1
. . . S $P(INPUT,"^",5)=1 ; Stop now
. . . K ZTREQ
;
I '$P(INPUT,"^",5) D
. S $P(INPUT,"^",6)=RCDT1 ; Start of Date Range
. S $P(INPUT,"^",7)=RCDT2 ; End of Date Range
. I 'RCEXCEL D RPT1(.INPUT)
. I RCEXCEL D EXCEL(INPUT) ; Print in Excel format ; PRCA*4.5*439 Add EXCEL
D ENQ(INPUT)
Q
;
ENQ(INPUT) ; Clean up
; Input: INPUT - A1^A2^A3^...^A8 Where:
; A1 - 1 if Detail report, 0 if summary report
; A2 - 1 if displaying to Listman, 0 otherwise
; A3 - 0 if NOT called from Nightly Process, 1 otherwise
; A4 - Current Page Number
; A5 - Stop Flag
; A6 - Start of Date Range
; A7 - End of Date Range
; ZTQUEUED - Defined if Joh was queued
; Output: ZTREQ - "@" Only returned if ZTQUEUED is defined
N XX,YY,ZZ
K ^TMP($J,"DEPERRS"),^TMP($J,"ONEDEP") ; PRCA*4.5*321
K ^TMP("RCDAILYACT",$J),^TMP("RCSELPAY",$J)
K ^TMP($J,"TOTALS")
K ^TMP("RCDPEU1",$J) ; PRCA*4.5*326
I '$D(ZTQUEUED) D
. D ^%ZISC
. S XX=$P(INPUT,"^",1) ; Nightly Process Flag
. S YY=$P(INPUT,"^",5) ; Stop Flag
. S ZZ=$P(INPUT,"^",4) ; Current Page Number
. I 'XX,'YY,ZZ D
. . S XX=""
. . D ASK^RCDPEARL(.XX)
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
RPT1(INPUT) ;EP from RCDPEM1 (Nightly Process)
; Output the report
; Input: INPUT - A1^A2^A3^...^An Where:
; A1 - 1 if called from Nightly Process, 0 otherwise
; A2 - 1 if displaying to Listman, 0 otherwise
; A4 - Current Page Number
; A5 - Stop Flag
; A6 - Start of Date Range
; A7 - End of Date Range
; ^TMP(B1,$J,B2,B3) = "" - Array of record IENs in 344.3 in date range
; and for selected payer(s) and division(s)
; ^TMP(B1,$J,B2,B3,"EFT",B4) = "" - Array of record IENS in 344.31 for above Where:
; B1 - "RCDAILYACT"
; B2 - Internal Date from DATE/TIME ADDED (344.3, .13)
; B3 - Internal IEN for 344.3
; B4 - Internal IEN for file 344.31
; Output: INPUT - A1^A2^A3^...^An - The following pieces may be updated
; A4 - Current Page Number
; A5 - Stop Flag
;
N CURPG,DETL,DTADD,DTEND,DTST,HDR1,LSTMAN,NJ
S DETL=$P(INPUT,"^",3) ; Detail Report flag
S LSTMAN=$P(INPUT,"^",2) ; Listman flag
S NJ=$P(INPUT,"^",1) ; Nightly Process flag
S CURPG=$P(INPUT,"^",4) ; Current Page Number
S DTST=$P(INPUT,"^",6) ; Date Range Start
S DTEND=$P(INPUT,"^",7) ; Date Range End
S $P(INPUT,"^",8)=0 ; Current line counter
S DTADD=""
F D Q:DTADD="" Q:$P(INPUT,"^",5)=1
. S DTADD=$O(^TMP("RCDAILYACT",$J,DTADD))
. Q:DTADD=""
. ;
. I 'LSTMAN,DETL D Q:$P(INPUT,"^",5)=1 ; PRCA*4.5*321
. . D HDR^RCDPEDA3(.INPUT)
. ;
. I DETL D ; Detail Report
. . S HDR1="DATE EFT DEPOSIT RECEIVED: "_$$FMTE^XLFDT(DTADD,"2Z") ; PRCA*4.5*321 moved location
. . S HDR1=$J("",80-$L(HDR1)\2)_HDR1 ; Center it
. . D SL^RCDPEDA3(.INPUT,HDR1)
. . D SL^RCDPEDA3(.INPUT," ")
. S $P(INPUT,"^",9)=DTADD
. D RPT2^RCDPEDA2(.INPUT) ; Process all 344.3 records found
. Q:$P(INPUT,"^",5)=1 ; User quit
. D TOTSDAY^RCDPEDA3(.INPUT) ; Display Totals for Date
;
Q:$P(INPUT,"^",5)=1 ; User quit
D TOTSF^RCDPEDA3(.INPUT) ; Display Final Totals
D SL^RCDPEDA3(.INPUT,$$ENDORPRT^RCDPEARL) ; Display End of Report
Q
;
CHKDIV(IEN,FLG,VAUTD) ;
; IEN - ien in file 344.31 or 344.4
; FLG - 0 if IEN contains ien in file 344.31, 1 if IEN contains ien in file 344.4
; VAUTD - array of selected divisions from DIVISION^VAUTOMA API call
; returns 1 if division associated with an entry in 344.31 is on the list in VAUTD
; returns 0 otherwise
N ERA,I,NAME,RCSTA,RES
S RES=0
I VAUTD=1 S RES=1 G CHKDIVX
I 'IEN G CHKDIVX
S ERA=$S(FLG:IEN,1:$P($G(^RCY(344.31,IEN,0)),U,10))
S RCSTA=$$ERASTA^RCDPEM3(ERA),NAME=$P(RCSTA,U)
I NAME="UNKNOWN" G CHKDIVX
S I=0 I 'VAUTD F S I=$O(VAUTD(I)) Q:'I!RES I NAME=VAUTD(I) S RES=1
CHKDIVX ;
Q RES
;
EXCEL(INPUT) ; Loop to print Excel Format ;PRCA*4.5*439 Add EXCEL tag
; Input: INPUT - A1^A2^A3^...^An Where:
; A1 - 1 if called from Nightly Process, 0 otherwise
; A2 - 1 if displaying to Listman, 0 otherwise
; A4 - Current Page Number
; A5 - Stop Flag
; A6 - Start of Date Range
; A7 - End of Date Range
; Output in Excel Format
D EXCELHDR^RCDPEDA4
N DTADD,IEN3443,IEN34431
;
S DTADD=""
F D Q:DTADD="" Q:$P(INPUT,"^",5)=1
. S DTADD=$O(^TMP("RCDAILYACT",$J,DTADD)) Q:DTADD=""
. S IEN3443=""
. F S IEN3443=$O(^TMP("RCDAILYACT",$J,DTADD,IEN3443)) Q:'IEN3443 D
. . S IEN34431=""
. . F S IEN34431=$O(^TMP("RCDAILYACT",$J,DTADD,IEN3443,"EFT",IEN34431)) Q:'IEN34431 D
. . . D EXCEL2(IEN3443,IEN34431)
;
W !!,"*** END OF REPORT ***",!
Q
;
EXCEL2(IEN3443,IEN34431) ; Print lines in Excel format ;PRCA*4.5*439 Add EXCEL3 tag
; Output in Excel foramt
; Input: IEN3443 - Internal IEN for 344.3
; IEN34431 - Internal IEN for file 344.31
;
N DEPDT,DEPNUM,DFLG,IEN344,MDT,MULT,PAMT,PAYER,PAYID,RCDBAL,RCDEBIT,TOTDEP,TRDOC,TRDOCS,TRSTAT,X,XX,YY
;PRCA*4.5*380 - Check for multiple mail messages on this deposit
S:$O(^RCY(344.3,IEN3443,3,0))'="" MULT="*"
;PRCA*4.5*380 - Check if prior deposits exist
S DEPNUM=$$GET1^DIQ(344.3,IEN3443,.06,"I"),DEPDT=$$GET1^DIQ(344.3,IEN3443,.07,"I") ; Deposit Number and Deposit Date
S XX=$O(^RCY(344.3,"ADEP2",DEPNUM,DEPDT,0)),XX=$O(^RCY(344.3,"ADEP2",DEPNUM,DEPDT,XX))
S:XX'="" MULT=$G(MULT)_"+"
S TOTDEP=$$GET1^DIQ(344.3,IEN3443,.08,"I") ; Total Deposit
S RCDBAL=$$DEPBAL^RCDPEDA4(IEN3443),RCDBAL=$S(RCDBAL:"",1:"UNBALANCED") ; Is Deposit balanceD, 0-No, 1-Yes
;PRCA*4.5*380 - Include multi-mail message indicator with date
W !,DEPNUM,"^",RCDBAL,"^",$$FMTE^XLFDT(DEPDT\1,"2Z"),$G(MULT),"^",TOTDEP,"^" ;Deposit #^Unbalanced Indicator^Deposit Date_Multi Flag^Total Deposit
S YY=$$GET1^DIQ(344.31,IEN34431,3,"E") ; Debit/Credit flag ; PRCA*4.5*321 added line
S DFLG=$S(YY="D":1,1:0) ; PRCA*4.5*321 added line
S PAMT=$$GET1^DIQ(344.31,IEN34431,.07,"I") ; Amount of Payment
S XX=+$$GET1^DIQ(344.31,IEN34431,.09,"I") ; Receipt # from 344.31
S TRDOC=$$GET1^DIQ(344,XX,200,"I") ; FMS Document #
I $$GET1^DIQ(344,XX,201,"I") S X="ACCEPTED" ; Default ON-LINE ENTRY status to accepted - PRCA*4.5*326
E S X=$S(TRDOC'="":$$STATUS^GECSSGET(TRDOC),1:"") ; PRCA*4.5*326
S XX=$S(X="":"",X=-1:"NO FMS DOC",1:$E($P(X," ",1),1,10))
W XX,"^"
S XX=$$GET1^DIQ(344.31,IEN34431,.01,"E") ; EFT Transaction detail - PRCA*4.5*326
W XX,"^"
S XX=$$GET1^DIQ(344.31,IEN34431,.12,"I") ; Date Claims Paid
W $$FMTE^XLFDT(XX\1,"2Z"),"^"
S XX=$$GET1^DIQ(344.31,IEN34431,.07,"I") ; Amount of Payment
S RCDEBIT=$$GET1^DIQ(344.31,IEN34431,3,"E") ; Check for Debit
I '($E(XX)="-") S XX=$S(RCDEBIT="D":"-",1:"")_XX ; If Debit, add minus sign
W XX,"^"
;
S XX=$$GET1^DIQ(344.31,IEN34431,.08,"I") ; Match Status, Internal
S YY=$$GET1^DIQ(344.31,IEN34431,.1,"I") ; ERA IEN
S MDT=""
I XX=1 S MDT=$$MATCHDT^RCDPEWL7(IEN34431) ; PRCA*4.5*326 - Date matched to ERA
S XX=$$GET1^DIQ(344.31,IEN34431,.08,"E") ; Match Status, External
W XX,"^",YY,"^",MDT,"^" ; Match Status^ERA^Date Matched
S XX=$$GET1^DIQ(344.31,IEN34431,.04,"I") ; Trace Number
W XX,"^"
S IEN344=$$GET1^DIQ(344.31,IEN34431,.09,"I") ; Receipt IEN
S XX=""
I IEN344'="" S XX=$$GET1^DIQ(344,IEN344,200,"I") ; FMS Document Number
W XX,"^"
S PAYER=$$GET1^DIQ(344.31,IEN34431,.02,"I") ; Payer Name
S:PAYER="" PAYER="NO PAYER NAME RECEIVED"
S PAYID=$$GET1^DIQ(344.31,IEN34431,.03,"I") ; Payer ID (TIN)
W PAYER,"^",PAYID,"^" ; Payer Name^Payer ID (TIN)
; Get TR #s
D EXCELTR(IEN344,IEN34431,.TRDOCS,.TRSTAT) ; Get comma delimited list of TR document #s and status
W TRDOCS,"^"
S XX=""
I IEN344'="" S XX=$$GET1^DIQ(344,IEN344,.01,"I") ; Receipt Number
W XX,"^"
W TRSTAT
Q
;
EXCELTR(IEN344,IEN34431,TRDOCS,TRSTAT) ;Get TR #s ;PRCA*4.5*439 Add EXCELTR tag
; Input: IEN344 - Internal IEN for file 344
; IEN34431 - Internal IEN for file 344.31
; TRDOCS - Variable to hold list of TR document numbers
;
; Output: TRDOCS - List of TR document numbers
;
N IEN3444,IENS,RECEIPT,TRDOC,XX
S TRDOCS="",TRSTAT="" ; Initialize list of TR document numbers and status
S IEN3444=$$GET1^DIQ(344.31,IEN34431,.1,"I") ; Internal IEN for for 344.4
S RECEIPT=+$$GET1^DIQ(344.31,IEN34431,.09,"I") ; Receipt # from 344.31
Q:'IEN3444
I $L(RECEIPT) D ; If a receipt exists, get FMS doc # and status
. S TRDOC=$TR($$GET1^DIQ(344,RECEIPT,200,"I")," ") ; FMS Document #
. I $$GET1^DIQ(344,RECEIPT,201,"I") S TRSTAT="ACCEPTED" ; Default ON-LINE ENTRY status to accepted - PRCA*4.5*326
. E S TRSTAT=$S(TRDOC'="":$$STATUS^GECSSGET(TRDOC),1:"")
;
S TRDOC=""
S RECEIPT=$$GET1^DIQ(344.4,IEN3444,.08,"I") ; Receipt # from 344.4
I RECEIPT="" Q
S TRDOC=$TR($$GET1^DIQ(344,RECEIPT,200,"I")," ") ; FMS Document #
I TRDOC="" Q
S TRDOCS=TRDOC ; First TR Document #
S XX=""
F D Q:XX="" ; If EFT is matched to an ERA, look for additional TR Documents
. S XX=$O(^RCY(344.4,IEN3444,8,XX))
. Q:XX=""
. S IENS=XX_","_IEN3444_","
. S RECEIPT=$$GET1^DIQ(344.48,IENS,.01,"I") ; Other receipt numbers
. I RECEIPT="" Q
. S TRDOC=$TR($$GET1^DIQ(344,RECEIPT,200,"I")," ") ; FMS Document #
. Q:TRDOC=""
. S TRDOCS=TRDOCS_","_TRDOC ; Comma delimited list of TR Document #s
Q
;
EXCELRST(IEN344,TRDOCS,TRSTAT) ; Get Deposit Receipt Status ;PRCA*4.5*439 Add EXCELRST tag
; Input: IEN344 - Internal IEN for 344
; TRDOCS - Variable to hold list of TR document numbers
; TRSTAT - Variable to hold Deposit Receipt Status
;
; Output: TRSTAT - Deposit Receipt Status
;
N TRDOC,X
S TRSTAT="" ; Initialize status to null
S TRDOC=$P(TRDOCS,",",1) ; Get first TR document, Deposit Receipt Status is null
Q:'$L(TRDOC) ; Quit if there isn't a TR document
I $$GET1^DIQ(344,IEN344,201,"I") S X="ACCEPTED" ; Default ON-LINE ENTRY status to accepted - PRCA*4.5*326
E S X=$S(TRDOC'="":$$STATUS^GECSSGET(TRDOC),1:"") ; PRCA*4.5*326
S TRSTAT=$S(X="":"",X=-1:"NO FMS DOC",1:$E($P(X," ",1),1,10)) ; FMS Document Status for EFT
Q
; Moved tags RCDPEDA4: RTYPE, DTRANGE, DBTONLY, EXCELHDR; PRCA*4.5*439
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEDAR 19737 printed Sep 23, 2025@19:20:34 Page 2
RCDPEDAR ;ALB/TMK - ACTIVITY REPORT ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,276,284,283,298,304,318,321,326,432,439**;Mar 20, 1995;Build 29
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
RPT ; Daily Activity Rpt On Demand
+1 ;PRCA*4.5*439
NEW POP,RCDET,RCDIV,RCDONLY,RCDT1,RCDT2,RCEXCEL,RCEXSTOP,RCHDR,RCINC,RCLSTMGR,RCNJ
+2 NEW RCPAR,RCPAY,RCPYRSEL,RCRANGE,RCSTOP,RCTMPND,RCTYPE,RCUNBAL,VAUTD,X,XX,Y,%ZIS
+3 ; Not the nightly job, user interactions
SET RCNJ=0
+4 ; IA 664 Select Division/Station - sets VAUTD
DO DIVISION^VAUTOMA
+5 IF 'VAUTD
IF ($DATA(VAUTD)'=11)
QUIT
+6 ; Select Report Type (Summary/Detail)
SET RCDET=$$RTYPE^RCDPEDA4()
+7 if RCDET=-1
QUIT
+8 ; Select Date Range to be used
SET XX=$$DTRANGE^RCDPEDA4(.RCDT1,.RCDT2)
+9 if 'XX
QUIT
+10 ;
+11 ; PRCA*4.5*326 - Ask to show Medical/Pharmacy Tricare CHAMPVA or All
+12 SET RCTYPE=$$RTYPE^RCDPEU1("")
+13 IF RCTYPE<0
QUIT
+14 ;
+15 ; PRCA*4.5*326 - Selected or Range of Payers
SET RCPAY=$$PAYRNG^RCDPEU1()
+16 ; PRCA*4.5*326 '^' or timeout
if RCPAY=-1
QUIT
+17 ;
+18 ; PRCA*4.5*326 - Since we don't want all payers
IF RCPAY'="A"
Begin DoDot:1
+19 ; prompt for payers we do want
SET RCPAR("SELC")=RCPAY
+20 SET RCPAR("TYPE")=RCTYPE
+21 SET RCPAR("FILE")=344.4
+22 SET RCPAR("DICA")="Select Insurance Company NAME: "
+23 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
End DoDot:1
if XX=-1
QUIT
+24 ;
+25 ; Debit only filter ;PRCA*4.5*321
SET RCDONLY=$$DBTONLY^RCDPEDA4()
+26 ; '^' or timeout
if RCDONLY=-1
QUIT
+27 ;
+28 ; Unbalanced only filter ;Add new filter, PRCA*4.5*439
SET RCUNBAL=$$UNBALONLY^RCDPEDA4()
+29 ; '^' or timeout
if RCUNBAL=-1
QUIT
+30 ;
+31 ; PRCA*4.5*439 Add Excel, begin
+32 ; if user selected detail report (RCDET=1), offer option of Excel format
+33 SET RCEXCEL=0
SET RCEXSTOP=0
IF RCDET
Begin DoDot:1
+34 SET RCEXCEL=$$DISPTY^RCDPEM3()
IF RCEXCEL<0
SET RCEXSTOP=1
QUIT
+35 ; display device info about Excel format, set ListMan flag to prevent question
+36 IF RCEXCEL
SET RCLSTMGR="^"
DO INFO^RCDPEM6
+37 IF $DATA(DUOUT)!$DATA(DTOUT)
SET RCEXSTOP=1
QUIT
End DoDot:1
if RCEXSTOP
QUIT
+38 ;
+39 ; if not output to Excel ask for ListMan display, quit if timeout or "^"
+40 SET RCLSTMGR=0
IF 'RCEXCEL
SET RCLSTMGR=$$ASKLM^RCDPEARL
if RCLSTMGR<0
QUIT
+41 ; PRCA*4.5*439 Add Excel, end
+42 ;
+43 ; ListMan Template format, put in array
IF RCLSTMGR=1
Begin DoDot:1
+44 SET RCTMPND="RCDPE_DAR"
+45 KILL ^TMP($JOB,RCTMPND)
+46 ; PRCA*4.5*439 RCUNBAL
DO EN(RCDET,RCDT1,RCDT2,RCLSTMGR,RCDONLY,0,RCUNBAL)
+47 DO LMHDR^RCDPEDA4(.RCSTOP,RCDET,1,RCDT1,RCDT2,.RCHDR,RCDONLY)
+48 ; Generate ListMan display
DO LMRPT^RCDPEARL(.RCHDR,$NAME(^TMP($JOB,RCTMPND)))
+49 KILL ^TMP($JOB,RCTMPND)
End DoDot:1
QUIT
+50 ;
+51 ; Ask device
+52 SET %ZIS="QM"
+53 DO ^%ZIS
+54 if POP
QUIT
+55 ;
+56 ; Queued Report
IF $DATA(IO("Q"))
Begin DoDot:1
+57 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+58 ;PRCA*4.5*321 added RCDONLY ;PRCA*4.5*439 added RCUNBAL
SET ZTRTN="EN^RCDPEDAR("_RCDET_","_RCDT1_","_RCDT2_",0,"_RCDONLY_",0,"_RCUNBAL_")"
+59 SET ZTDESC="AR - EDI LOCKBOX EFT DAILY ACTIVITY REPORT"
+60 SET ZTSAVE("RC*")=""
SET ZTSAVE("VAUTD")=""
+61 ; PRCA*4.5*326
SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
+62 ;
+63 DO ^%ZTLOAD
+64 WRITE !!,$SELECT($DATA(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
+65 KILL ZTSK,IO("Q")
+66 DO HOME^%ZIS
End DoDot:1
QUIT
+67 ;
+68 USE IO
+69 ;PRCA*4.5*439 Add RCEXCEL, added RCUNBAL
DO EN(RCDET,RCDT1,RCDT2,RCLSTMGR,RCDONLY,RCEXCEL,RCUNBAL)
+70 QUIT
+71 ;
EN(RCDET,RCDT1,RCDT2,RCLSTMGR,DONLY,RCEXCEL,RCUNBAL) ; Entry point for report, might be queued
+1 ; Input: RCDET - 1 - Detail Report, 0 - Summary
+2 ; RCDT1 - Internal Fileman Start date
+3 ; RCDT2 - Internal Fileman End date
+4 ; RCLSTMGR - 1 display in list manager, 0 otherwise
+5 ; Optional, defaults to 0
+6 ; DONLY - 1 only display EFTs with a debit flag of 'D'
+7 ; 0 display all EFTs
+8 ; RCEXCEL - 1 display in Excel format, 0 otherwise ;PRCA*4.5*439 Add Excel
+9 ; Optional, defaults to 0
+10 ; RCUNBAL - A - All, B - Balanced, U - Unbalanced ; PRCA*4.5*439 Add Unbalanced/Balanced selection
+11 ; Optional, defaults to All
+12 ; RCPAY - A - All Payers selected
+13 ; - R - Range of Payers
+14 ; - S - Specific payers
+15 ; RCPYRSEL - Array of selected payers (Only present if A1=3 above
+16 ; VAUTD - 1 - All selected divisions OR an array of selected divisions
+17 ; PRCA*4.5*321 Added DFLG ; PRCA*4.5*439 Added RCDBAL,RCDBALOK
NEW DFLG,DTADD,IEN3443,IEN34431,INPUT,RCDBAL,RCDBALOK,RCFLG,RCJOB,RCT,XX,Z
+18 ; Job was tasked, ZTSTOP = flag to stop
if $GET(ZTSK)
NEW ZTSTOP
+19 if '$DATA(RCLSTMGR)
SET RCLSTMGR=0
+20 ;PRCA*4.5*439 Add Excel
if '$DATA(RCEXCEL)
SET RCEXCEL=0
+21 ;PRCA*4.5*439 Add Unbalanced/Balanced selection
if '$DATA(RCUNBAL)
SET RCUNBAL="A"
+22 ; PRCA*4.5*326
SET RCPAY=$GET(RCPAY,"A")
+23 ;
+24 SET XX=$SELECT(RCLSTMGR:1,1:0)
+25 SET INPUT=XX_"^"_RCLSTMGR_"^"_+RCDET
+26 SET RCJOB=$JOB
+27 KILL ^TMP("RCDAILYACT",$JOB)
+28 ; Initialize Totals temp workspace
KILL ^TMP($JOB,"TOTALS")
+29 ;
+30 ; Loop through all of the EDI LOCKBOX DEPOSIT records in the selected date
+31 ; range and add any that pass the payer and division filters into ^TMP
+32 ; by the internal date added
+33 SET DTADD=RCDT1-.0001
SET RCT=0
+34 ; Current Page Number
SET $PIECE(INPUT,"^",4)=0
+35 ; Stop Flag
SET $PIECE(INPUT,"^",5)=0
+36 SET $PIECE(INPUT,"^",10)=DONLY
+37 ; User selection: A - All, B - Balanced, U - Unbalanced PRCA*4.5*439
SET $PIECE(INPUT,"^",11)=RCUNBAL
+38 FOR
Begin DoDot:1
+39 SET DTADD=$ORDER(^RCY(344.3,"ARECDT",DTADD))
+40 if 'DTADD
QUIT
+41 if DTADD>(RCDT2_".9999")
QUIT
+42 SET IEN3443=0
+43 FOR
Begin DoDot:2
+44 SET IEN3443=$ORDER(^RCY(344.3,"ARECDT",DTADD,IEN3443))
+45 if 'IEN3443
QUIT
+46 ;Add block of code to check for balanced or out of balance deposits PRCA*4.5*439
+47 ;Check user's filter selection, match to balance state of deposit
+48 ;Only check for balanced or not if user did not select 'A' for ALL.
+49 ;If deposit balance/unbalance doesn't match user selection, quit to ignore this deposit.
IF RCUNBAL'="A"
SET RCDBALOK=1
Begin DoDot:3
+50 ;Check deposit balance. Compare to EFT totals. 1 if in balance, 0 if out of balance.
SET RCDBAL=$$DEPBAL^RCDPEDA4(IEN3443)
+51 ; If user selected unbalanced deposits in filter selection, skip balanced deposits by setting okay flag to zero (RCDBALOK).
+52 IF RCUNBAL="U"
if RCDBAL
SET RCDBALOK=0
QUIT
+53 ; If user selected balanced deposits in filter selection, skip unbalanced deposits by setting okay flag to zero (RCDBALOK).
+54 IF RCUNBAL="B"
if 'RCDBAL
SET RCDBALOK=0
QUIT
End DoDot:3
IF 'RCDBALOK
QUIT
+55 SET IEN34431=""
SET RCFLG=0
+56 FOR
Begin DoDot:3
+57 SET IEN34431=$ORDER(^RCY(344.31,"B",IEN3443,IEN34431))
+58 if IEN34431=""
QUIT
+59 ;
+60 IF RCPAY'="A"
Begin DoDot:4
+61 ; PRCA*4.5*326 Check if payer was selected
SET XX=$$ISSEL^RCDPEU1(344.31,IEN34431)
End DoDot:4
if 'XX
QUIT
+62 ; If all of a given type of payer selected
IF RCTYPE'="A"
Begin DoDot:4
+63 ; check that payer matches type
SET XX=$$ISTYPE^RCDPEU1(344.31,IEN34431,RCTYPE)
End DoDot:4
if 'XX
QUIT
+64 ;
+65 ; Not a selected station/division
if '$$CHKDIV(IEN34431,0,.VAUTD)
QUIT
+66 ;
+67 ; PRCA*4.5*321 Added filter for Debit EFTs Only below
+68 ; Not an EFT with a debit flag of 'D'
IF DONLY
Begin DoDot:4
+69 SET DFLG=$$GET1^DIQ(344.31,IEN34431,3,"E")
End DoDot:4
if DFLG'="D"
QUIT
+70 SET RCFLG=1
+71 SET ^TMP("RCDAILYACT",$JOB,DTADD\1,IEN3443,"EFT",IEN34431)=""
End DoDot:3
if IEN34431=""
QUIT
+72 ;
+73 if RCFLG
SET ^TMP("RCDAILYACT",$JOB,DTADD\1,IEN3443)=""
+74 ; Current Record Count
SET RCT=RCT+1
+75 ;
+76 ; Check for user stopped every 100 records
+77 IF '(RCT#100)
IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
Begin DoDot:3
+78 SET ZTSTOP=1
+79 ; Stop now
SET $PIECE(INPUT,"^",5)=1
+80 KILL ZTREQ
End DoDot:3
QUIT
End DoDot:2
if 'IEN3443
QUIT
if $PIECE(INPUT,"^",5)=1
QUIT
End DoDot:1
if 'DTADD
QUIT
if DTADD>(RCDT2_".9999")
QUIT
if $PIECE(INPUT,"^",5)=1
QUIT
+81 ;
+82 IF '$PIECE(INPUT,"^",5)
Begin DoDot:1
+83 ; Start of Date Range
SET $PIECE(INPUT,"^",6)=RCDT1
+84 ; End of Date Range
SET $PIECE(INPUT,"^",7)=RCDT2
+85 IF 'RCEXCEL
DO RPT1(.INPUT)
+86 ; Print in Excel format ; PRCA*4.5*439 Add EXCEL
IF RCEXCEL
DO EXCEL(INPUT)
End DoDot:1
+87 DO ENQ(INPUT)
+88 QUIT
+89 ;
ENQ(INPUT) ; Clean up
+1 ; Input: INPUT - A1^A2^A3^...^A8 Where:
+2 ; A1 - 1 if Detail report, 0 if summary report
+3 ; A2 - 1 if displaying to Listman, 0 otherwise
+4 ; A3 - 0 if NOT called from Nightly Process, 1 otherwise
+5 ; A4 - Current Page Number
+6 ; A5 - Stop Flag
+7 ; A6 - Start of Date Range
+8 ; A7 - End of Date Range
+9 ; ZTQUEUED - Defined if Joh was queued
+10 ; Output: ZTREQ - "@" Only returned if ZTQUEUED is defined
+11 NEW XX,YY,ZZ
+12 ; PRCA*4.5*321
KILL ^TMP($JOB,"DEPERRS"),^TMP($JOB,"ONEDEP")
+13 KILL ^TMP("RCDAILYACT",$JOB),^TMP("RCSELPAY",$JOB)
+14 KILL ^TMP($JOB,"TOTALS")
+15 ; PRCA*4.5*326
KILL ^TMP("RCDPEU1",$JOB)
+16 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+17 DO ^%ZISC
+18 ; Nightly Process Flag
SET XX=$PIECE(INPUT,"^",1)
+19 ; Stop Flag
SET YY=$PIECE(INPUT,"^",5)
+20 ; Current Page Number
SET ZZ=$PIECE(INPUT,"^",4)
+21 IF 'XX
IF 'YY
IF ZZ
Begin DoDot:2
+22 SET XX=""
+23 DO ASK^RCDPEARL(.XX)
End DoDot:2
End DoDot:1
+24 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+25 QUIT
+26 ;
RPT1(INPUT) ;EP from RCDPEM1 (Nightly Process)
+1 ; Output the report
+2 ; Input: INPUT - A1^A2^A3^...^An Where:
+3 ; A1 - 1 if called from Nightly Process, 0 otherwise
+4 ; A2 - 1 if displaying to Listman, 0 otherwise
+5 ; A4 - Current Page Number
+6 ; A5 - Stop Flag
+7 ; A6 - Start of Date Range
+8 ; A7 - End of Date Range
+9 ; ^TMP(B1,$J,B2,B3) = "" - Array of record IENs in 344.3 in date range
+10 ; and for selected payer(s) and division(s)
+11 ; ^TMP(B1,$J,B2,B3,"EFT",B4) = "" - Array of record IENS in 344.31 for above Where:
+12 ; B1 - "RCDAILYACT"
+13 ; B2 - Internal Date from DATE/TIME ADDED (344.3, .13)
+14 ; B3 - Internal IEN for 344.3
+15 ; B4 - Internal IEN for file 344.31
+16 ; Output: INPUT - A1^A2^A3^...^An - The following pieces may be updated
+17 ; A4 - Current Page Number
+18 ; A5 - Stop Flag
+19 ;
+20 NEW CURPG,DETL,DTADD,DTEND,DTST,HDR1,LSTMAN,NJ
+21 ; Detail Report flag
SET DETL=$PIECE(INPUT,"^",3)
+22 ; Listman flag
SET LSTMAN=$PIECE(INPUT,"^",2)
+23 ; Nightly Process flag
SET NJ=$PIECE(INPUT,"^",1)
+24 ; Current Page Number
SET CURPG=$PIECE(INPUT,"^",4)
+25 ; Date Range Start
SET DTST=$PIECE(INPUT,"^",6)
+26 ; Date Range End
SET DTEND=$PIECE(INPUT,"^",7)
+27 ; Current line counter
SET $PIECE(INPUT,"^",8)=0
+28 SET DTADD=""
+29 FOR
Begin DoDot:1
+30 SET DTADD=$ORDER(^TMP("RCDAILYACT",$JOB,DTADD))
+31 if DTADD=""
QUIT
+32 ;
+33 ; PRCA*4.5*321
IF 'LSTMAN
IF DETL
Begin DoDot:2
+34 DO HDR^RCDPEDA3(.INPUT)
End DoDot:2
if $PIECE(INPUT,"^",5)=1
QUIT
+35 ;
+36 ; Detail Report
IF DETL
Begin DoDot:2
+37 ; PRCA*4.5*321 moved location
SET HDR1="DATE EFT DEPOSIT RECEIVED: "_$$FMTE^XLFDT(DTADD,"2Z")
+38 ; Center it
SET HDR1=$JUSTIFY("",80-$LENGTH(HDR1)\2)_HDR1
+39 DO SL^RCDPEDA3(.INPUT,HDR1)
+40 DO SL^RCDPEDA3(.INPUT," ")
End DoDot:2
+41 SET $PIECE(INPUT,"^",9)=DTADD
+42 ; Process all 344.3 records found
DO RPT2^RCDPEDA2(.INPUT)
+43 ; User quit
if $PIECE(INPUT,"^",5)=1
QUIT
+44 ; Display Totals for Date
DO TOTSDAY^RCDPEDA3(.INPUT)
End DoDot:1
if DTADD=""
QUIT
if $PIECE(INPUT,"^",5)=1
QUIT
+45 ;
+46 ; User quit
if $PIECE(INPUT,"^",5)=1
QUIT
+47 ; Display Final Totals
DO TOTSF^RCDPEDA3(.INPUT)
+48 ; Display End of Report
DO SL^RCDPEDA3(.INPUT,$$ENDORPRT^RCDPEARL)
+49 QUIT
+50 ;
CHKDIV(IEN,FLG,VAUTD) ;
+1 ; IEN - ien in file 344.31 or 344.4
+2 ; FLG - 0 if IEN contains ien in file 344.31, 1 if IEN contains ien in file 344.4
+3 ; VAUTD - array of selected divisions from DIVISION^VAUTOMA API call
+4 ; returns 1 if division associated with an entry in 344.31 is on the list in VAUTD
+5 ; returns 0 otherwise
+6 NEW ERA,I,NAME,RCSTA,RES
+7 SET RES=0
+8 IF VAUTD=1
SET RES=1
GOTO CHKDIVX
+9 IF 'IEN
GOTO CHKDIVX
+10 SET ERA=$SELECT(FLG:IEN,1:$PIECE($GET(^RCY(344.31,IEN,0)),U,10))
+11 SET RCSTA=$$ERASTA^RCDPEM3(ERA)
SET NAME=$PIECE(RCSTA,U)
+12 IF NAME="UNKNOWN"
GOTO CHKDIVX
+13 SET I=0
IF 'VAUTD
FOR
SET I=$ORDER(VAUTD(I))
if 'I!RES
QUIT
IF NAME=VAUTD(I)
SET RES=1
CHKDIVX ;
+1 QUIT RES
+2 ;
EXCEL(INPUT) ; Loop to print Excel Format ;PRCA*4.5*439 Add EXCEL tag
+1 ; Input: INPUT - A1^A2^A3^...^An Where:
+2 ; A1 - 1 if called from Nightly Process, 0 otherwise
+3 ; A2 - 1 if displaying to Listman, 0 otherwise
+4 ; A4 - Current Page Number
+5 ; A5 - Stop Flag
+6 ; A6 - Start of Date Range
+7 ; A7 - End of Date Range
+8 ; Output in Excel Format
+9 DO EXCELHDR^RCDPEDA4
+10 NEW DTADD,IEN3443,IEN34431
+11 ;
+12 SET DTADD=""
+13 FOR
Begin DoDot:1
+14 SET DTADD=$ORDER(^TMP("RCDAILYACT",$JOB,DTADD))
if DTADD=""
QUIT
+15 SET IEN3443=""
+16 FOR
SET IEN3443=$ORDER(^TMP("RCDAILYACT",$JOB,DTADD,IEN3443))
if 'IEN3443
QUIT
Begin DoDot:2
+17 SET IEN34431=""
+18 FOR
SET IEN34431=$ORDER(^TMP("RCDAILYACT",$JOB,DTADD,IEN3443,"EFT",IEN34431))
if 'IEN34431
QUIT
Begin DoDot:3
+19 DO EXCEL2(IEN3443,IEN34431)
End DoDot:3
End DoDot:2
End DoDot:1
if DTADD=""
QUIT
if $PIECE(INPUT,"^",5)=1
QUIT
+20 ;
+21 WRITE !!,"*** END OF REPORT ***",!
+22 QUIT
+23 ;
EXCEL2(IEN3443,IEN34431) ; Print lines in Excel format ;PRCA*4.5*439 Add EXCEL3 tag
+1 ; Output in Excel foramt
+2 ; Input: IEN3443 - Internal IEN for 344.3
+3 ; IEN34431 - Internal IEN for file 344.31
+4 ;
+5 NEW DEPDT,DEPNUM,DFLG,IEN344,MDT,MULT,PAMT,PAYER,PAYID,RCDBAL,RCDEBIT,TOTDEP,TRDOC,TRDOCS,TRSTAT,X,XX,YY
+6 ;PRCA*4.5*380 - Check for multiple mail messages on this deposit
+7 if $ORDER(^RCY(344.3,IEN3443,3,0))'=""
SET MULT="*"
+8 ;PRCA*4.5*380 - Check if prior deposits exist
+9 ; Deposit Number and Deposit Date
SET DEPNUM=$$GET1^DIQ(344.3,IEN3443,.06,"I")
SET DEPDT=$$GET1^DIQ(344.3,IEN3443,.07,"I")
+10 SET XX=$ORDER(^RCY(344.3,"ADEP2",DEPNUM,DEPDT,0))
SET XX=$ORDER(^RCY(344.3,"ADEP2",DEPNUM,DEPDT,XX))
+11 if XX'=""
SET MULT=$GET(MULT)_"+"
+12 ; Total Deposit
SET TOTDEP=$$GET1^DIQ(344.3,IEN3443,.08,"I")
+13 ; Is Deposit balanceD, 0-No, 1-Yes
SET RCDBAL=$$DEPBAL^RCDPEDA4(IEN3443)
SET RCDBAL=$SELECT(RCDBAL:"",1:"UNBALANCED")
+14 ;PRCA*4.5*380 - Include multi-mail message indicator with date
+15 ;Deposit #^Unbalanced Indicator^Deposit Date_Multi Flag^Total Deposit
WRITE !,DEPNUM,"^",RCDBAL,"^",$$FMTE^XLFDT(DEPDT\1,"2Z"),$GET(MULT),"^",TOTDEP,"^"
+16 ; Debit/Credit flag ; PRCA*4.5*321 added line
SET YY=$$GET1^DIQ(344.31,IEN34431,3,"E")
+17 ; PRCA*4.5*321 added line
SET DFLG=$SELECT(YY="D":1,1:0)
+18 ; Amount of Payment
SET PAMT=$$GET1^DIQ(344.31,IEN34431,.07,"I")
+19 ; Receipt # from 344.31
SET XX=+$$GET1^DIQ(344.31,IEN34431,.09,"I")
+20 ; FMS Document #
SET TRDOC=$$GET1^DIQ(344,XX,200,"I")
+21 ; Default ON-LINE ENTRY status to accepted - PRCA*4.5*326
IF $$GET1^DIQ(344,XX,201,"I")
SET X="ACCEPTED"
+22 ; PRCA*4.5*326
IF '$TEST
SET X=$SELECT(TRDOC'="":$$STATUS^GECSSGET(TRDOC),1:"")
+23 SET XX=$SELECT(X="":"",X=-1:"NO FMS DOC",1:$EXTRACT($PIECE(X," ",1),1,10))
+24 WRITE XX,"^"
+25 ; EFT Transaction detail - PRCA*4.5*326
SET XX=$$GET1^DIQ(344.31,IEN34431,.01,"E")
+26 WRITE XX,"^"
+27 ; Date Claims Paid
SET XX=$$GET1^DIQ(344.31,IEN34431,.12,"I")
+28 WRITE $$FMTE^XLFDT(XX\1,"2Z"),"^"
+29 ; Amount of Payment
SET XX=$$GET1^DIQ(344.31,IEN34431,.07,"I")
+30 ; Check for Debit
SET RCDEBIT=$$GET1^DIQ(344.31,IEN34431,3,"E")
+31 ; If Debit, add minus sign
IF '($EXTRACT(XX)="-")
SET XX=$SELECT(RCDEBIT="D":"-",1:"")_XX
+32 WRITE XX,"^"
+33 ;
+34 ; Match Status, Internal
SET XX=$$GET1^DIQ(344.31,IEN34431,.08,"I")
+35 ; ERA IEN
SET YY=$$GET1^DIQ(344.31,IEN34431,.1,"I")
+36 SET MDT=""
+37 ; PRCA*4.5*326 - Date matched to ERA
IF XX=1
SET MDT=$$MATCHDT^RCDPEWL7(IEN34431)
+38 ; Match Status, External
SET XX=$$GET1^DIQ(344.31,IEN34431,.08,"E")
+39 ; Match Status^ERA^Date Matched
WRITE XX,"^",YY,"^",MDT,"^"
+40 ; Trace Number
SET XX=$$GET1^DIQ(344.31,IEN34431,.04,"I")
+41 WRITE XX,"^"
+42 ; Receipt IEN
SET IEN344=$$GET1^DIQ(344.31,IEN34431,.09,"I")
+43 SET XX=""
+44 ; FMS Document Number
IF IEN344'=""
SET XX=$$GET1^DIQ(344,IEN344,200,"I")
+45 WRITE XX,"^"
+46 ; Payer Name
SET PAYER=$$GET1^DIQ(344.31,IEN34431,.02,"I")
+47 if PAYER=""
SET PAYER="NO PAYER NAME RECEIVED"
+48 ; Payer ID (TIN)
SET PAYID=$$GET1^DIQ(344.31,IEN34431,.03,"I")
+49 ; Payer Name^Payer ID (TIN)
WRITE PAYER,"^",PAYID,"^"
+50 ; Get TR #s
+51 ; Get comma delimited list of TR document #s and status
DO EXCELTR(IEN344,IEN34431,.TRDOCS,.TRSTAT)
+52 WRITE TRDOCS,"^"
+53 SET XX=""
+54 ; Receipt Number
IF IEN344'=""
SET XX=$$GET1^DIQ(344,IEN344,.01,"I")
+55 WRITE XX,"^"
+56 WRITE TRSTAT
+57 QUIT
+58 ;
EXCELTR(IEN344,IEN34431,TRDOCS,TRSTAT) ;Get TR #s ;PRCA*4.5*439 Add EXCELTR tag
+1 ; Input: IEN344 - Internal IEN for file 344
+2 ; IEN34431 - Internal IEN for file 344.31
+3 ; TRDOCS - Variable to hold list of TR document numbers
+4 ;
+5 ; Output: TRDOCS - List of TR document numbers
+6 ;
+7 NEW IEN3444,IENS,RECEIPT,TRDOC,XX
+8 ; Initialize list of TR document numbers and status
SET TRDOCS=""
SET TRSTAT=""
+9 ; Internal IEN for for 344.4
SET IEN3444=$$GET1^DIQ(344.31,IEN34431,.1,"I")
+10 ; Receipt # from 344.31
SET RECEIPT=+$$GET1^DIQ(344.31,IEN34431,.09,"I")
+11 if 'IEN3444
QUIT
+12 ; If a receipt exists, get FMS doc # and status
IF $LENGTH(RECEIPT)
Begin DoDot:1
+13 ; FMS Document #
SET TRDOC=$TRANSLATE($$GET1^DIQ(344,RECEIPT,200,"I")," ")
+14 ; Default ON-LINE ENTRY status to accepted - PRCA*4.5*326
IF $$GET1^DIQ(344,RECEIPT,201,"I")
SET TRSTAT="ACCEPTED"
+15 IF '$TEST
SET TRSTAT=$SELECT(TRDOC'="":$$STATUS^GECSSGET(TRDOC),1:"")
End DoDot:1
+16 ;
+17 SET TRDOC=""
+18 ; Receipt # from 344.4
SET RECEIPT=$$GET1^DIQ(344.4,IEN3444,.08,"I")
+19 IF RECEIPT=""
QUIT
+20 ; FMS Document #
SET TRDOC=$TRANSLATE($$GET1^DIQ(344,RECEIPT,200,"I")," ")
+21 IF TRDOC=""
QUIT
+22 ; First TR Document #
SET TRDOCS=TRDOC
+23 SET XX=""
+24 ; If EFT is matched to an ERA, look for additional TR Documents
FOR
Begin DoDot:1
+25 SET XX=$ORDER(^RCY(344.4,IEN3444,8,XX))
+26 if XX=""
QUIT
+27 SET IENS=XX_","_IEN3444_","
+28 ; Other receipt numbers
SET RECEIPT=$$GET1^DIQ(344.48,IENS,.01,"I")
+29 IF RECEIPT=""
QUIT
+30 ; FMS Document #
SET TRDOC=$TRANSLATE($$GET1^DIQ(344,RECEIPT,200,"I")," ")
+31 if TRDOC=""
QUIT
+32 ; Comma delimited list of TR Document #s
SET TRDOCS=TRDOCS_","_TRDOC
End DoDot:1
if XX=""
QUIT
+33 QUIT
+34 ;
EXCELRST(IEN344,TRDOCS,TRSTAT) ; Get Deposit Receipt Status ;PRCA*4.5*439 Add EXCELRST tag
+1 ; Input: IEN344 - Internal IEN for 344
+2 ; TRDOCS - Variable to hold list of TR document numbers
+3 ; TRSTAT - Variable to hold Deposit Receipt Status
+4 ;
+5 ; Output: TRSTAT - Deposit Receipt Status
+6 ;
+7 NEW TRDOC,X
+8 ; Initialize status to null
SET TRSTAT=""
+9 ; Get first TR document, Deposit Receipt Status is null
SET TRDOC=$PIECE(TRDOCS,",",1)
+10 ; Quit if there isn't a TR document
if '$LENGTH(TRDOC)
QUIT
+11 ; Default ON-LINE ENTRY status to accepted - PRCA*4.5*326
IF $$GET1^DIQ(344,IEN344,201,"I")
SET X="ACCEPTED"
+12 ; PRCA*4.5*326
IF '$TEST
SET X=$SELECT(TRDOC'="":$$STATUS^GECSSGET(TRDOC),1:"")
+13 ; FMS Document Status for EFT
SET TRSTAT=$SELECT(X="":"",X=-1:"NO FMS DOC",1:$EXTRACT($PIECE(X," ",1),1,10))
+14 QUIT
+15 ; Moved tags RCDPEDA4: RTYPE, DTRANGE, DBTONLY, EXCELHDR; PRCA*4.5*439
