RCDPE8NZ ;ALB/TMK/KML/JCH - Unapplied EFT Deposits report ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,212,208,269,276,283,293,298,317,318,326,375,371,432**;Mar 20, 1995;Build 16
;Per VA Directive 6402, this routine should not be modified.
;
EN ; entry point for Unapplied EFT Deposits Report [RCDPE UNAPPLIED EFT DEP REPORT]
; ^RCY(344.3,0) = EDI LOCKBOX DEPOSIT^344.3I^
;
N %ZIS,DIR,RCDET,RCDISPTY,RCDTRNG,RCENDT,RCHDR,RCLNCNT,RCLSTMGR,RCPGNUM,RCRPLST,RCSTDT,RCTMPND,RCTYPE,RPTQ,X,Y
; RCDET - detail report or grand totals only
; RCDISPTY - display type for Excel
; RCDTRNG - range of dates
; RCHDR - report header
; RCLNCNT - line counter for ^TMP storage
; RCLSTMGR - ListMan flag
; RCPGNUM - page number
; RCRPLST - node for report list in ^TMP
; RCTMPND - storage node (or null) for SL^RCPEARL
; RCTYPE - Payer type filter M - MEDICAL, P-PHARMACY, T-TRICARE, C-CHAMPVA, A-ALL ;PRCA*4.5*432 CHAMPVA
;
S RCRPLST=$T(+0)_"_EFT" ; storage for list of entries
S RCLNCNT=0,RCLSTMGR="",RCTMPND="" ; initial values for ListMan
S RCDET=$$RDET("D") G:(RCDET=-1) RPTQ ; PRCA*4.5*371 - Prompt for detail report or grand total only
S RCTYPE="A",(RCDTRNG,RCSTDT,RCENDT,RCDISPTY,RCLSTMGR)="",RPTQ=0 ; PRCA*4.5*371 - Make sure these don't crash grand totals report
;PRCA*4.5*371 - Change G RPTQ commands to setting a quit variable, because GOTO in a DO block apparently doesn't actually GOTO
I RCDET'="G" D G:RPTQ RPTQ ;PRCA*4.5*371 - Don't prompt for any other options if grand total only selected
.S RCTYPE=$$RTYPE^RCDPEU1("A") I (RCTYPE=-1) S RPTQ=1 Q ; PRCA*4.5*326 - Add M/P/T filter
.S RCDTRNG=$$DTRNG^RCDPEM4() I '(RCDTRNG>0) S RPTQ=1 Q
.S RCSTDT=$P(RCDTRNG,U,2),RCENDT=$P(RCDTRNG,U,3)
.; ask if export to excel
.S RCDISPTY=$$DISPTY^RCDPEM3() I RCDISPTY<0 S RPTQ=1 Q
.; for Excel, set ListMan flag to prevent question
.I RCDISPTY S RCLSTMGR="^" D INFO^RCDPEM6
.I RCLSTMGR="" S RCLSTMGR=$$ASKLM^RCDPEARL I RCLSTMGR<0 S RPTQ=1 Q
.I RCLSTMGR D S RPTQ=1 Q ; send output to ListMan
..S RCTMPND=$T(+0)_"^UNAPPLIED EFT" K ^TMP($J,RCTMPND) ; clean any residue
..D MKRPRT
..N H,L,HDR S L=0
..S HDR("TITLE")=$$HDRNM
..F H=1:1:7 I $D(RCHDR(H)) S L=H,HDR(H)=RCHDR(H) ; take first 3 lines of report header
..I $O(RCHDR(L)) D ; any remaining header lines at top of report
...N N S N=0,H=L F S H=$O(RCHDR(H)) Q:'H S N=N+.001,^TMP($J,RCTMPND,N)=RCHDR(H)
..; invoke ListMan
..D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display
;
; Ask device
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
.N ZTRTN,ZTSAVE,ZTDESC,POP,ZTSK
.S ZTRTN="MKRPRT^RCDPE8NZ",ZTDESC="AR - List of unlinked EFT deposit payments"
.S ZTSAVE("RC*")=""
.D ^%ZTLOAD
.W !!,$S($G(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
D MKRPRT
Q
;
MKRPRT ; Entry point for queued job
N RCTSKCNT,RCARDEP,RCCR,RCDA,RCDATA,RCDT,RCEFT,RCEFTIEN,RCREC,RCSTAT,RCSTOP,RCSUM,RCTOT,RCTR,RCUNAP,RECEXT,Y,Z,ZTSTOP
;
; get list of unlinked EFT deposit data
K ^TMP(RCRPLST,$J) ; subscripts: dep date,EFT ien,EFT det ien
; Data is FMS doc indicator^FMS doc #^FMS Doc Status
; FMS doc indicator = -1:no receipt -2:no FMS doc 1:FMS doc exists
;
S (RCTSKCNT,RCSTOP,RCSUM,RCUNAP)=0
S RCARDEP="" F S RCARDEP=$O(^RCY(344.3,"ARDEP",RCARDEP)) Q:RCARDEP=""!RCSTOP S RCDA=0 F S RCDA=$O(^RCY(344.3,"ARDEP",RCARDEP,RCDA)) Q:'RCDA D Q:RCSTOP
. S RCDATA=$G(^RCY(344.3,RCDA,0)),RCDT=$P(RCDATA,U,7),RCTOT=0
. Q:+RCSTDT&(RCDT<RCSTDT) ; Before start date
. Q:+RCENDT&(RCDT>(RCENDT+.999999)) ; After the end date
. Q:'$P(RCDATA,"^",8) ; no payment amt
. S RCEFT=0 F S RCEFT=$O(^RCY(344.31,"B",RCDA,RCEFT)) Q:'RCEFT!RCSTOP S RCDATA(0)=$G(^RCY(344.31,RCEFT,0)) D Q:RCSTOP
. . I '$$ISTYPE^RCDPEU1(344.31,RCEFT,RCTYPE) Q ;PRCA*4.5*326
. . Q:$P($G(^RCY(344.31,RCEFT,0)),U,16)="D" ; PRCA*4.5*375 - Do not show Debit EFTs because there's nothing to apply
. . S RCTSKCNT=RCTSKCNT+1
. . I '(RCTSKCNT#100),$D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ Q
. . Q:$P($G(^RCY(344.31,RCEFT,3)),U) ; EFT has been removed PRCA*4.5*293
. . S RCREC=$$GETREC(RCEFT,RCDATA(0),.RECEXT)
. . Q:RCREC="PURGED" ; need to prevent processed EFTs that had receipts purged from being generated on the report
. . ;; PRCA276 - need to add EFT entries without a receipt to the total number of unapplied deposits
. . I 'RCREC S RCUNAP=RCUNAP+1,^TMP(RCRPLST,$J,RCDT,RCDA,RCEFT)=-1,RCTOT=RCTOT+$P(RCDATA(0),U,7) Q ; No receipt therefore no FMS document
. . S RCSTAT=$$FMSSTAT^RCDPUREC(RCREC)
. . I $E($P(RCSTAT,U),1,2)="TR",$P(RCSTAT,U,2)["ACCEPTED" Q
. . S RCUNAP=RCUNAP+1,RCTOT=RCTOT+$P(RCDATA(0),U,7) ; total unapplied deposits and total dollar amount of unapplied deposits
. . I $P(RCSTAT,U,2)="NOT ENTERED" S ^TMP(RCRPLST,$J,RCDT,RCDA,RCEFT)="-2^^"_$P(RCSTAT,U) Q ; No FMS doc
. . S ^TMP(RCRPLST,$J,RCDT,RCDA,RCEFT)="1^"_$P(RCSTAT,U,1,2)_"^"_RECEXT
. S:RCTOT ^TMP(RCRPLST,$J,RCDT,RCDA)=RCTOT,RCSUM=RCSUM+RCTOT
;
D:'RCLSTMGR HDRBLD
D:RCLSTMGR HDRLM
;
I RCDISPTY D EXCEL Q
;
D RPT
Q
;
RPT ; display/print the report using data populated in temporary global array
N RCPAYID,RCPAYER,XX,YY,ZZ ;PRCA*4.5*318
;
D:'RCLSTMGR HDRLST^RCDPEARL(.RCSTOP,.RCHDR) ; initial report header
G:RCDET="G" RPTQ ; PRCA*4.5*371 - Quit here if grand totals only report
;
S RCDT=0
F S RCDT=$O(^TMP(RCRPLST,$J,RCDT)) Q:'RCDT D Q:RCSTOP
.I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
.D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND) ; skip a line
.S Y="DEPOSIT DATE: "_$$FMTE^XLFDT(RCDT,1),Y=$J("",80-$L(Y)\2)_Y D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
.S RCARDEP=0 F S RCARDEP=$O(^TMP(RCRPLST,$J,RCDT,RCARDEP)) Q:'RCARDEP D
..D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND) ; skip a line
..S RCTSKCNT=RCTSKCNT+1 I 'RCLSTMGR,(RCTSKCNT#100),$D(ZTQUEUED),$$S^%ZTLOAD D Q ; stop task
...S (RCSTOP,ZTSTOP)=1 D SL^RCDPEARL("TASK STOPPED BY USER!!",.RCLNCNT,RCTMPND) K ZTREQ
..;
..S RCDATA(0)=$G(^RCY(344.3,RCARDEP,0))
..I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
..; PRCA*4.5*283 - Change the spaces for DEP # from 10 to 13 to allow 9 digit DEP #
..; PRCA*4.5*317 Shift line 2 chars to the right
..S Y=" "_$E($P(RCDATA(0),U,6)_$S('$$HACEFT^RCDPEU(RCARDEP):"",1:"-HAC")_$J("",13),1,13) ;deposit #
..S Y=Y_" "_$E($$FMTE^XLFDT($P(RCDATA(0),U,7),2)_$J("",16),1,16) ; deposit date
..S Y=Y_" "_$E($J(+$P(RCDATA(0),U,8),"",2)_$J("",20),1,20) ; total amt deposit
..S Y=Y_" "_$J(+$G(^TMP(RCRPLST,$J,RCDT,RCARDEP)),"",2) ; total amt unposted
..D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
..S RCEFTIEN=0 F S RCEFTIEN=$O(^TMP(RCRPLST,$J,RCDT,RCARDEP,RCEFTIEN)) Q:'RCEFTIEN S RCDATA=$G(^(RCEFTIEN)),RCEFT("DEP")=$G(^RCY(344.31,RCEFTIEN,0)) D
...I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
...N RCPAY S RCPAY=$P(RCEFT("DEP"),U,2) S:RCPAY="" RCPAY="NO PAYER NAME RECEIVED" ; PRCA*4.5*298
...;
...; PRCA*4.5*317 Shift line 2 chars to the right
...;S Y=" "_RCPAY_"/"_$P(RCEFT("DEP"),U,3) D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND) ; payer/ID
...; PRCA*4.5*318 Account for payer names of 60 characters and payer ID of 20 characters
...S RCPAYID=$P(RCEFT("DEP"),U,3)
...S RCPAYER=RCPAY_"/"_RCPAYID ; payer/ID
...I $L(RCPAYER)>77 D
... . S ZZ=$L(RCPAYER,"/"),XX=$P(RCPAYER,"/",1,ZZ-1),YY=$P(RCPAYER,"/",ZZ)
... . S XX=$E(XX,1,$L(XX)-($L(RCPAYER)-77)),RCPAYER=XX_"/"_YY
...S Y=" "_RCPAYER
...; end of PRCA*4.5*318
...D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND) ; payer/ID
...; PRCA*4.5*317 Shift line 2 chars to the right
...S Y=" "_$E($P(RCEFT("DEP"),U,4)_$J("",50),1,50) ; trace #
...S Y=Y_" "_$E($J(+$P(RCEFT("DEP"),U,7),"",2)_$J("",12),1,12) ; payment amt
...;
...; PRCA*4.5*317 Shift lines 2 to thr right to allow 12 digit receipt #
...S Y=Y_" "_$S($P(RCDATA,U,4)'="":$P(RCDATA,U,4),1:"NO RECEIPT") ; receipt #
... D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
...; PRCA*4.5*317 Shift line 2 chars to the right
...S Z=$P(RCEFT("DEP"),U,8)
...S Y=" "_$E($S('Z:"UNMATCHED",Z=2:"PAPER EOB",1:"MATCHED TO ERA #: "_$P(RCEFT("DEP"),U,10)_$S(Z=-1:" (TOTALS MISMATCH)",1:""))_$J("",40),1,40)_" "
...S Y=Y_$S($P(RCDATA,U)=-1:"NO RECEIPT",$P(RCDATA,U)=-2:"NO FMS DOCUMENT",1:$E($P(RCDATA,U,2)_" - "_$P(RCDATA,U,3),1,30))
...D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
;
I '$D(^TMP(RCRPLST,$J)) D SL^RCDPEARL("*** NO RECORDS TO PRINT ***",.RCLNCNT,RCTMPND)
;
I 'RCSTOP D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND),SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND)
I $D(ZTQUEUED) S ZTREQ="@"
D:'$D(ZTQUEUED) ^%ZISC
G:RCSTOP RPTQ
;
RPTQ ;
I '$G(RCLSTMGR),'$G(RCSTOP),$E(IOST,1,2)="C-" D ASK^RCDPEARL(.RCSTOP)
K ^TMP(RCRPLST,$J)
Q
;
GETREC(EFTDA,EFTDET,RECEXT) ; function, prca276
; input - EFTDA - IEN OF 344.31
; input - EFTDET - data stored at the 0 subscript of the THIRD PARTY EFT DETAIL file (344.31)
; input - RECEXT passed by reference
; output - RECEXT populated with the external receipt value that gets generated on the report
; output - RECEIPT - returns internal value of the receipt that either comes from the EFT file (344.31) or the ERA file (344.4)
N RECEIPT
S RECEXT=0
S RECEIPT=+$P($G(^RCY(344.4,+$P(EFTDET,U,10),0)),U,8) ; get receipt off the ERA record
I 'RECEIPT,$P(EFTDET,U,8)=2 S RECEIPT=+$O(^RCY(344,"AEFT",EFTDA,0)) ; EFT processed against paper EOB
I 'RECEIPT S RECEIPT=$P(EFTDET,U,9) ; receipt not posted in payment file so get from EFT detail (unprocessed EFT)
I +RECEIPT,'$D(^RCY(344,RECEIPT)) Q "PURGED" ; handle purged receipts but broken pointer exists in 344.31; need to handle as a processed EFT
I +RECEIPT S RECEXT=$P(^RCY(344,RECEIPT,0),U)
Q +RECEIPT
;
;
HDRBLD ; create the report header
; returns RCHDR, RCPGNUM, RCSTOP
; RCHDR(0) = header text line count
; RCHDR("XECUTE") = M code for page number
; RCHDR("RUNDATE") = date/time report generated, external format
; RCPGNUM - page counter
; RCSTOP - flag to exit
; INPUT:
; RCDISPTY - Display/print/Excel flag
; RCRTYP - Report Type (EOB or ERA)
; VAUTD
K RCHDR S RCHDR("RUNDATE")=$$NOW^RCDPEARL,RCPGNUM=0,RCSTOP=0
;
;
I RCDISPTY D Q ; Excel format, xecute code is QUIT, null page number
.S RCHDR(0)=1,RCHDR("XECUTE")="Q",RCPGNUM=""
.S RCHDR(1)="DEPOSIT #^DEPOSIT DATE^TOT AMT DEPOSIT^TOT AMT UNPOSTED^PAYER ID^TRACE #^PAYMENT AMT^RECEIPT #^ERA MATCHED^FMS DOC #/STATUS"
;
N DIV,HCNT,Y
S HCNT=0 ; header counter
;
S Y=$$HDRNM,HCNT=1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y ; line 1 will be replaced by XECUTE code below
S RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$T(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"
S Y="Run Date: "_RCHDR("RUNDATE")
I RCDET'="G" D ; PRCA*4.5*371 - Don't display MPT information in Grand Totals report
. S Y=Y_" MEDICAL/PHARMACY/TRICARE/CHAMPVA: " ; PRCA*4.5*326 ;PRCA*4.5*432 CHAMPVA
. S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL") ; PRCA*4.5*326 ;PRCA*4.5*432 CHAMPVA
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y
;
S:RCDET="G" Y="GRAND TOTAL",Y=$J("",80-$L(Y)\2)_Y ; PRCA*4.5*371 - Grand Totals report
S:RCDET'="G" Y="Date Range: "_$$FMTE^XLFDT(RCSTDT,2)_" - "_$$FMTE^XLFDT(RCENDT,2)_" (Deposit Date)",Y=$J("",80-$L(Y)\2)_Y
S HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y="TOTAL NUMBER OF UNAPPLIED DEPOSITS: "_RCUNAP,HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y
S Y="TOTAL AMOUNT OF UNAPPLIED DEPOSITS: $"_$FN(RCSUM,",",2),HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y
S HCNT=HCNT+1,RCHDR(HCNT)=""
;
I RCDET'="G" D ; PRCA*4.5*371 - Don't display details on grand total report
.; PRCA*4.5*317 Shift each line 2 chars to the right
.S HCNT=HCNT+1,RCHDR(HCNT)=" DEPOSIT # DEPOSIT DATE TOT AMT OF DEPOSIT TOT AMT UNPOSTED"
.S HCNT=HCNT+1,RCHDR(HCNT)=" PAYER/ID"
.S HCNT=HCNT+1,RCHDR(HCNT)=$J("",4)_"TRACE #"_$J("",44)_"PAYMENT AMT RECEIPT #"
.S HCNT=HCNT+1,RCHDR(HCNT)=$J("",6)_$E("ERA MATCHED"_$J("",40),1,40)_" FMS DOC #/STATUS"
.; PRCA*4.5*317 End
S Y="",$P(Y,"=",81)="",HCNT=HCNT+1,RCHDR(HCNT)=Y ; row of equal signs at bottom
;
S RCHDR(0)=HCNT ; header line count
Q
;
HDRLM ; create the report header
; returns RCHDR
; RCHDR(0) = header text line count
; INPUT:
; RCSTDT - Date Range
K RCHDR
;
N DIV,HCNT,Y
S HCNT=0 ; header counter
S Y="Date Range: "_$$FMTE^XLFDT(RCSTDT,2)_" - "_$$FMTE^XLFDT(RCENDT,2)_" (Deposit Date) "
S Y=Y_"MED/PHARM/TRIC/CHAMPVA: " ; PRCA*4.5*326 ;PRCA*4.5*432 CHAMPVA
S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL") ; PRCA*4.5*326 ;PRCA*4.5*432 CHAMPVA
S HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y="TOTAL NUMBER OF UNAPPLIED DEPOSITS: "_RCUNAP,HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y="TOTAL AMOUNT OF UNAPPLIED DEPOSITS: $"_$FN(RCSUM,",",2),HCNT=HCNT+1,RCHDR(HCNT)=Y
;
; PRCA*4.5*317 Shift each line 2 chars to the right
S HCNT=HCNT+1,RCHDR(HCNT)=" DEPOSIT # DEPOSIT DATE TOT AMT OF DEPOSIT TOT AMT UNPOSTED"
S HCNT=HCNT+1,RCHDR(HCNT)=" PAYER/ID"
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",4)_"TRACE #"_$J("",44)_"PAYMENT AMT RECEIPT #"
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",6)_$E("ERA MATCHED"_$J("",40),1,40)_" FMS DOC #/STATUS"
; PRCA*4.5*317 End
;
S RCHDR(0)=HCNT ; header line count
Q
;
; extrinsic variable, name for header PRCA*4.5*298
HDRNM() Q "Unapplied EFT Deposits Report"
;
EXCEL ; Print report formatted for export to Excel
N STR1
W !,$G(RCHDR(1)),!
S RCDT=0 F S RCDT=$O(^TMP(RCRPLST,$J,RCDT)) Q:'RCDT D Q:RCSTOP
.S RCARDEP=0 F S RCARDEP=$O(^TMP(RCRPLST,$J,RCDT,RCARDEP)) Q:'RCARDEP D
..S RCDATA(0)=$G(^RCY(344.3,RCARDEP,0))
..S STR1=$P(RCDATA(0),U,6)_$S('$$HACEFT^RCDPEU(RCARDEP):"",1:"-HAC")_U_$$FMTE^XLFDT($P(RCDATA(0),U,7))_U_$P(RCDATA(0),U,8)_U
..S STR1=STR1_+$G(^TMP(RCRPLST,$J,RCDT,RCARDEP))_U
..S RCEFTIEN=0 F S RCEFTIEN=$O(^TMP(RCRPLST,$J,RCDT,RCARDEP,RCEFTIEN)) Q:'RCEFTIEN S RCDATA=$G(^(RCEFTIEN)),RCEFT("DEP")=$G(^RCY(344.31,RCEFTIEN,0)) D
...W STR1 S:$P(RCEFT("DEP"),U,2)="" $P(RCEFT("DEP"),U,2)="NO PAYER NAME RECEIVED" ;PRCA*4.5*298
...W $P(RCEFT("DEP"),U,2)_"/"_$P(RCEFT("DEP"),U,3)_U_$P(RCEFT("DEP"),U,4)_U
...W +$P(RCEFT("DEP"),U,7)_U_$S($P(RCDATA,U,4)'="":$P(RCDATA,U,4),1:"NO RECEIPT")_U
...W $P(RCEFT("DEP"),U,10)_U
...W $S($P(RCDATA,U)=-1:"NO RECEIPT",$P(RCDATA,U)=-2:"NO FMS DOCUMENT",1:$P(RCDATA,U,2)_" - "_$P(RCDATA,U,3))
...W !
Q
;
; PRCA*4.5*371 - Add subroutine
RDET(DEF) ; Prompt for full report or just grand total
; Input: DEF - Value to use a default
; Returns: -1 - User ^ or timed out
; D - User selected DETAIL REPORT
; G - User selected GRAND TOTAL
N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN
S RCTYPE=""
S DIR("?")="Enter the type of report to run"
S DIR(0)="SA^D:DETAIL;G:GRAND TOTAL"
S DIR("A")="(D)ETAIL REPORT or (G)RAND TOTAL?: "
S DIR("B")=$S($G(DEF)'="":DEF,1:"D")
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q:Y="" "A"
S RETURN=$E(Y)
Q RETURN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPE8NZ 15351 printed Dec 13, 2024@01:44:04 Page 2
RCDPE8NZ ;ALB/TMK/KML/JCH - Unapplied EFT Deposits report ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,212,208,269,276,283,293,298,317,318,326,375,371,432**;Mar 20, 1995;Build 16
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; entry point for Unapplied EFT Deposits Report [RCDPE UNAPPLIED EFT DEP REPORT]
+1 ; ^RCY(344.3,0) = EDI LOCKBOX DEPOSIT^344.3I^
+2 ;
+3 NEW %ZIS,DIR,RCDET,RCDISPTY,RCDTRNG,RCENDT,RCHDR,RCLNCNT,RCLSTMGR,RCPGNUM,RCRPLST,RCSTDT,RCTMPND,RCTYPE,RPTQ,X,Y
+4 ; RCDET - detail report or grand totals only
+5 ; RCDISPTY - display type for Excel
+6 ; RCDTRNG - range of dates
+7 ; RCHDR - report header
+8 ; RCLNCNT - line counter for ^TMP storage
+9 ; RCLSTMGR - ListMan flag
+10 ; RCPGNUM - page number
+11 ; RCRPLST - node for report list in ^TMP
+12 ; RCTMPND - storage node (or null) for SL^RCPEARL
+13 ; RCTYPE - Payer type filter M - MEDICAL, P-PHARMACY, T-TRICARE, C-CHAMPVA, A-ALL ;PRCA*4.5*432 CHAMPVA
+14 ;
+15 ; storage for list of entries
SET RCRPLST=$TEXT(+0)_"_EFT"
+16 ; initial values for ListMan
SET RCLNCNT=0
SET RCLSTMGR=""
SET RCTMPND=""
+17 ; PRCA*4.5*371 - Prompt for detail report or grand total only
SET RCDET=$$RDET("D")
if (RCDET=-1)
GOTO RPTQ
+18 ; PRCA*4.5*371 - Make sure these don't crash grand totals report
SET RCTYPE="A"
SET (RCDTRNG,RCSTDT,RCENDT,RCDISPTY,RCLSTMGR)=""
SET RPTQ=0
+19 ;PRCA*4.5*371 - Change G RPTQ commands to setting a quit variable, because GOTO in a DO block apparently doesn't actually GOTO
+20 ;PRCA*4.5*371 - Don't prompt for any other options if grand total only selected
IF RCDET'="G"
Begin DoDot:1
+21 ; PRCA*4.5*326 - Add M/P/T filter
SET RCTYPE=$$RTYPE^RCDPEU1("A")
IF (RCTYPE=-1)
SET RPTQ=1
QUIT
+22 SET RCDTRNG=$$DTRNG^RCDPEM4()
IF '(RCDTRNG>0)
SET RPTQ=1
QUIT
+23 SET RCSTDT=$PIECE(RCDTRNG,U,2)
SET RCENDT=$PIECE(RCDTRNG,U,3)
+24 ; ask if export to excel
+25 SET RCDISPTY=$$DISPTY^RCDPEM3()
IF RCDISPTY<0
SET RPTQ=1
QUIT
+26 ; for Excel, set ListMan flag to prevent question
+27 IF RCDISPTY
SET RCLSTMGR="^"
DO INFO^RCDPEM6
+28 IF RCLSTMGR=""
SET RCLSTMGR=$$ASKLM^RCDPEARL
IF RCLSTMGR<0
SET RPTQ=1
QUIT
+29 ; send output to ListMan
IF RCLSTMGR
Begin DoDot:2
+30 ; clean any residue
SET RCTMPND=$TEXT(+0)_"^UNAPPLIED EFT"
KILL ^TMP($JOB,RCTMPND)
+31 DO MKRPRT
+32 NEW H,L,HDR
SET L=0
+33 SET HDR("TITLE")=$$HDRNM
+34 ; take first 3 lines of report header
FOR H=1:1:7
IF $DATA(RCHDR(H))
SET L=H
SET HDR(H)=RCHDR(H)
+35 ; any remaining header lines at top of report
IF $ORDER(RCHDR(L))
Begin DoDot:3
+36 NEW N
SET N=0
SET H=L
FOR
SET H=$ORDER(RCHDR(H))
if 'H
QUIT
SET N=N+.001
SET ^TMP($JOB,RCTMPND,N)=RCHDR(H)
End DoDot:3
+37 ; invoke ListMan
+38 ; generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP($JOB,RCTMPND)))
End DoDot:2
SET RPTQ=1
QUIT
End DoDot:1
if RPTQ
GOTO RPTQ
+39 ;
+40 ; Ask device
+41 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+42 IF $DATA(IO("Q"))
Begin DoDot:1
+43 NEW ZTRTN,ZTSAVE,ZTDESC,POP,ZTSK
+44 SET ZTRTN="MKRPRT^RCDPE8NZ"
SET ZTDESC="AR - List of unlinked EFT deposit payments"
+45 SET ZTSAVE("RC*")=""
+46 DO ^%ZTLOAD
+47 WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
+48 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+49 ;
+50 USE IO
+51 DO MKRPRT
+52 QUIT
+53 ;
MKRPRT ; Entry point for queued job
+1 NEW RCTSKCNT,RCARDEP,RCCR,RCDA,RCDATA,RCDT,RCEFT,RCEFTIEN,RCREC,RCSTAT,RCSTOP,RCSUM,RCTOT,RCTR,RCUNAP,RECEXT,Y,Z,ZTSTOP
+2 ;
+3 ; get list of unlinked EFT deposit data
+4 ; subscripts: dep date,EFT ien,EFT det ien
KILL ^TMP(RCRPLST,$JOB)
+5 ; Data is FMS doc indicator^FMS doc #^FMS Doc Status
+6 ; FMS doc indicator = -1:no receipt -2:no FMS doc 1:FMS doc exists
+7 ;
+8 SET (RCTSKCNT,RCSTOP,RCSUM,RCUNAP)=0
+9 SET RCARDEP=""
FOR
SET RCARDEP=$ORDER(^RCY(344.3,"ARDEP",RCARDEP))
if RCARDEP=""!RCSTOP
QUIT
SET RCDA=0
FOR
SET RCDA=$ORDER(^RCY(344.3,"ARDEP",RCARDEP,RCDA))
if 'RCDA
QUIT
Begin DoDot:1
+10 SET RCDATA=$GET(^RCY(344.3,RCDA,0))
SET RCDT=$PIECE(RCDATA,U,7)
SET RCTOT=0
+11 ; Before start date
if +RCSTDT&(RCDT<RCSTDT)
QUIT
+12 ; After the end date
if +RCENDT&(RCDT>(RCENDT+.999999))
QUIT
+13 ; no payment amt
if '$PIECE(RCDATA,"^",8)
QUIT
+14 SET RCEFT=0
FOR
SET RCEFT=$ORDER(^RCY(344.31,"B",RCDA,RCEFT))
if 'RCEFT!RCSTOP
QUIT
SET RCDATA(0)=$GET(^RCY(344.31,RCEFT,0))
Begin DoDot:2
+15 ;PRCA*4.5*326
IF '$$ISTYPE^RCDPEU1(344.31,RCEFT,RCTYPE)
QUIT
+16 ; PRCA*4.5*375 - Do not show Debit EFTs because there's nothing to apply
if $PIECE($GET(^RCY(344.31,RCEFT,0)),U,16)="D"
QUIT
+17 SET RCTSKCNT=RCTSKCNT+1
+18 IF '(RCTSKCNT#100)
IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (RCSTOP,ZTSTOP)=1
KILL ZTREQ
QUIT
+19 ; EFT has been removed PRCA*4.5*293
if $PIECE($GET(^RCY(344.31,RCEFT,3)),U)
QUIT
+20 SET RCREC=$$GETREC(RCEFT,RCDATA(0),.RECEXT)
+21 ; need to prevent processed EFTs that had receipts purged from being generated on the report
if RCREC="PURGED"
QUIT
+22 ;; PRCA276 - need to add EFT entries without a receipt to the total number of unapplied deposits
+23 ; No receipt therefore no FMS document
IF 'RCREC
SET RCUNAP=RCUNAP+1
SET ^TMP(RCRPLST,$JOB,RCDT,RCDA,RCEFT)=-1
SET RCTOT=RCTOT+$PIECE(RCDATA(0),U,7)
QUIT
+24 SET RCSTAT=$$FMSSTAT^RCDPUREC(RCREC)
+25 IF $EXTRACT($PIECE(RCSTAT,U),1,2)="TR"
IF $PIECE(RCSTAT,U,2)["ACCEPTED"
QUIT
+26 ; total unapplied deposits and total dollar amount of unapplied deposits
SET RCUNAP=RCUNAP+1
SET RCTOT=RCTOT+$PIECE(RCDATA(0),U,7)
+27 ; No FMS doc
IF $PIECE(RCSTAT,U,2)="NOT ENTERED"
SET ^TMP(RCRPLST,$JOB,RCDT,RCDA,RCEFT)="-2^^"_$PIECE(RCSTAT,U)
QUIT
+28 SET ^TMP(RCRPLST,$JOB,RCDT,RCDA,RCEFT)="1^"_$PIECE(RCSTAT,U,1,2)_"^"_RECEXT
End DoDot:2
if RCSTOP
QUIT
+29 if RCTOT
SET ^TMP(RCRPLST,$JOB,RCDT,RCDA)=RCTOT
SET RCSUM=RCSUM+RCTOT
End DoDot:1
if RCSTOP
QUIT
+30 ;
+31 if 'RCLSTMGR
DO HDRBLD
+32 if RCLSTMGR
DO HDRLM
+33 ;
+34 IF RCDISPTY
DO EXCEL
QUIT
+35 ;
+36 DO RPT
+37 QUIT
+38 ;
RPT ; display/print the report using data populated in temporary global array
+1 ;PRCA*4.5*318
NEW RCPAYID,RCPAYER,XX,YY,ZZ
+2 ;
+3 ; initial report header
if 'RCLSTMGR
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
+4 ; PRCA*4.5*371 - Quit here if grand totals only report
if RCDET="G"
GOTO RPTQ
+5 ;
+6 SET RCDT=0
+7 FOR
SET RCDT=$ORDER(^TMP(RCRPLST,$JOB,RCDT))
if 'RCDT
QUIT
Begin DoDot:1
+8 IF 'RCLSTMGR
IF $Y>(IOSL-RCHDR(0))
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
if RCSTOP
QUIT
+9 ; skip a line
DO SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)
+10 SET Y="DEPOSIT DATE: "_$$FMTE^XLFDT(RCDT,1)
SET Y=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
+11 SET RCARDEP=0
FOR
SET RCARDEP=$ORDER(^TMP(RCRPLST,$JOB,RCDT,RCARDEP))
if 'RCARDEP
QUIT
Begin DoDot:2
+12 ; skip a line
DO SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)
+13 ; stop task
SET RCTSKCNT=RCTSKCNT+1
IF 'RCLSTMGR
IF (RCTSKCNT#100)
IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
Begin DoDot:3
+14 SET (RCSTOP,ZTSTOP)=1
DO SL^RCDPEARL("TASK STOPPED BY USER!!",.RCLNCNT,RCTMPND)
KILL ZTREQ
End DoDot:3
QUIT
+15 ;
+16 SET RCDATA(0)=$GET(^RCY(344.3,RCARDEP,0))
+17 IF 'RCLSTMGR
IF $Y>(IOSL-RCHDR(0))
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
if RCSTOP
QUIT
+18 ; PRCA*4.5*283 - Change the spaces for DEP # from 10 to 13 to allow 9 digit DEP #
+19 ; PRCA*4.5*317 Shift line 2 chars to the right
+20 ;deposit #
SET Y=" "_$EXTRACT($PIECE(RCDATA(0),U,6)_$SELECT('$$HACEFT^RCDPEU(RCARDEP):"",1:"-HAC")_$JUSTIFY("",13),1,13)
+21 ; deposit date
SET Y=Y_" "_$EXTRACT($$FMTE^XLFDT($PIECE(RCDATA(0),U,7),2)_$JUSTIFY("",16),1,16)
+22 ; total amt deposit
SET Y=Y_" "_$EXTRACT($JUSTIFY(+$PIECE(RCDATA(0),U,8),"",2)_$JUSTIFY("",20),1,20)
+23 ; total amt unposted
SET Y=Y_" "_$JUSTIFY(+$GET(^TMP(RCRPLST,$JOB,RCDT,RCARDEP)),"",2)
+24 DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
+25 SET RCEFTIEN=0
FOR
SET RCEFTIEN=$ORDER(^TMP(RCRPLST,$JOB,RCDT,RCARDEP,RCEFTIEN))
if 'RCEFTIEN
QUIT
SET RCDATA=$GET(^(RCEFTIEN))
SET RCEFT("DEP")=$GET(^RCY(344.31,RCEFTIEN,0))
Begin DoDot:3
+26 IF 'RCLSTMGR
IF $Y>(IOSL-RCHDR(0))
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
if RCSTOP
QUIT
+27 ; PRCA*4.5*298
NEW RCPAY
SET RCPAY=$PIECE(RCEFT("DEP"),U,2)
if RCPAY=""
SET RCPAY="NO PAYER NAME RECEIVED"
+28 ;
+29 ; PRCA*4.5*317 Shift line 2 chars to the right
+30 ;S Y=" "_RCPAY_"/"_$P(RCEFT("DEP"),U,3) D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND) ; payer/ID
+31 ; PRCA*4.5*318 Account for payer names of 60 characters and payer ID of 20 characters
+32 SET RCPAYID=$PIECE(RCEFT("DEP"),U,3)
+33 ; payer/ID
SET RCPAYER=RCPAY_"/"_RCPAYID
+34 IF $LENGTH(RCPAYER)>77
Begin DoDot:4
+35 SET ZZ=$LENGTH(RCPAYER,"/")
SET XX=$PIECE(RCPAYER,"/",1,ZZ-1)
SET YY=$PIECE(RCPAYER,"/",ZZ)
+36 SET XX=$EXTRACT(XX,1,$LENGTH(XX)-($LENGTH(RCPAYER)-77))
SET RCPAYER=XX_"/"_YY
End DoDot:4
+37 SET Y=" "_RCPAYER
+38 ; end of PRCA*4.5*318
+39 ; payer/ID
DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
+40 ; PRCA*4.5*317 Shift line 2 chars to the right
+41 ; trace #
SET Y=" "_$EXTRACT($PIECE(RCEFT("DEP"),U,4)_$JUSTIFY("",50),1,50)
+42 ; payment amt
SET Y=Y_" "_$EXTRACT($JUSTIFY(+$PIECE(RCEFT("DEP"),U,7),"",2)_$JUSTIFY("",12),1,12)
+43 ;
+44 ; PRCA*4.5*317 Shift lines 2 to thr right to allow 12 digit receipt #
+45 ; receipt #
SET Y=Y_" "_$SELECT($PIECE(RCDATA,U,4)'="":$PIECE(RCDATA,U,4),1:"NO RECEIPT")
+46 DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
+47 ; PRCA*4.5*317 Shift line 2 chars to the right
+48 SET Z=$PIECE(RCEFT("DEP"),U,8)
+49 SET Y=" "_$EXTRACT($SELECT('Z:"UNMATCHED",Z=2:"PAPER EOB",1:"MATCHED TO ERA #: "_$PIECE(RCEFT("DEP"),U,10)_$SELECT(Z=-1:" (TOTALS MISMATCH)",1:""))_$JUSTIFY("",40),1,40)_" "
+50 SET Y=Y_$SELECT($PIECE(RCDATA,U)=-1:"NO RECEIPT",$PIECE(RCDATA,U)=-2:"NO FMS DOCUMENT",1:$EXTRACT($PIECE(RCDATA,U,2)_" - "_$PIECE(RCDATA,U,3),1,30))
+51 DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
End DoDot:3
End DoDot:2
End DoDot:1
if RCSTOP
QUIT
+52 ;
+53 IF '$DATA(^TMP(RCRPLST,$JOB))
DO SL^RCDPEARL("*** NO RECORDS TO PRINT ***",.RCLNCNT,RCTMPND)
+54 ;
+55 IF 'RCSTOP
DO SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)
DO SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND)
+56 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+57 if '$DATA(ZTQUEUED)
DO ^%ZISC
+58 if RCSTOP
GOTO RPTQ
+59 ;
RPTQ ;
+1 IF '$GET(RCLSTMGR)
IF '$GET(RCSTOP)
IF $EXTRACT(IOST,1,2)="C-"
DO ASK^RCDPEARL(.RCSTOP)
+2 KILL ^TMP(RCRPLST,$JOB)
+3 QUIT
+4 ;
GETREC(EFTDA,EFTDET,RECEXT) ; function, prca276
+1 ; input - EFTDA - IEN OF 344.31
+2 ; input - EFTDET - data stored at the 0 subscript of the THIRD PARTY EFT DETAIL file (344.31)
+3 ; input - RECEXT passed by reference
+4 ; output - RECEXT populated with the external receipt value that gets generated on the report
+5 ; output - RECEIPT - returns internal value of the receipt that either comes from the EFT file (344.31) or the ERA file (344.4)
+6 NEW RECEIPT
+7 SET RECEXT=0
+8 ; get receipt off the ERA record
SET RECEIPT=+$PIECE($GET(^RCY(344.4,+$PIECE(EFTDET,U,10),0)),U,8)
+9 ; EFT processed against paper EOB
IF 'RECEIPT
IF $PIECE(EFTDET,U,8)=2
SET RECEIPT=+$ORDER(^RCY(344,"AEFT",EFTDA,0))
+10 ; receipt not posted in payment file so get from EFT detail (unprocessed EFT)
IF 'RECEIPT
SET RECEIPT=$PIECE(EFTDET,U,9)
+11 ; handle purged receipts but broken pointer exists in 344.31; need to handle as a processed EFT
IF +RECEIPT
IF '$DATA(^RCY(344,RECEIPT))
QUIT "PURGED"
+12 IF +RECEIPT
SET RECEXT=$PIECE(^RCY(344,RECEIPT,0),U)
+13 QUIT +RECEIPT
+14 ;
+15 ;
HDRBLD ; create the report header
+1 ; returns RCHDR, RCPGNUM, RCSTOP
+2 ; RCHDR(0) = header text line count
+3 ; RCHDR("XECUTE") = M code for page number
+4 ; RCHDR("RUNDATE") = date/time report generated, external format
+5 ; RCPGNUM - page counter
+6 ; RCSTOP - flag to exit
+7 ; INPUT:
+8 ; RCDISPTY - Display/print/Excel flag
+9 ; RCRTYP - Report Type (EOB or ERA)
+10 ; VAUTD
+11 KILL RCHDR
SET RCHDR("RUNDATE")=$$NOW^RCDPEARL
SET RCPGNUM=0
SET RCSTOP=0
+12 ;
+13 ;
+14 ; Excel format, xecute code is QUIT, null page number
IF RCDISPTY
Begin DoDot:1
+15 SET RCHDR(0)=1
SET RCHDR("XECUTE")="Q"
SET RCPGNUM=""
+16 SET RCHDR(1)="DEPOSIT #^DEPOSIT DATE^TOT AMT DEPOSIT^TOT AMT UNPOSTED^PAYER ID^TRACE #^PAYMENT AMT^RECEIPT #^ERA MATCHED^FMS DOC #/STATUS"
End DoDot:1
QUIT
+17 ;
+18 NEW DIV,HCNT,Y
+19 ; header counter
SET HCNT=0
+20 ;
+21 ; line 1 will be replaced by XECUTE code below
SET Y=$$HDRNM
SET HCNT=1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+22 SET RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$TEXT(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"
+23 SET Y="Run Date: "_RCHDR("RUNDATE")
+24 ; PRCA*4.5*371 - Don't display MPT information in Grand Totals report
IF RCDET'="G"
Begin DoDot:1
+25 ; PRCA*4.5*326 ;PRCA*4.5*432 CHAMPVA
SET Y=Y_" MEDICAL/PHARMACY/TRICARE/CHAMPVA: "
+26 ; PRCA*4.5*326 ;PRCA*4.5*432 CHAMPVA
SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")
End DoDot:1
+27 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+28 ;
+29 ; PRCA*4.5*371 - Grand Totals report
if RCDET="G"
SET Y="GRAND TOTAL"
SET Y=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+30 if RCDET'="G"
SET Y="Date Range: "_$$FMTE^XLFDT(RCSTDT,2)_" - "_$$FMTE^XLFDT(RCENDT,2)_" (Deposit Date)"
SET Y=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+31 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+32 SET Y="TOTAL NUMBER OF UNAPPLIED DEPOSITS: "_RCUNAP
SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+33 SET Y="TOTAL AMOUNT OF UNAPPLIED DEPOSITS: $"_$FNUMBER(RCSUM,",",2)
SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+34 SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+35 ;
+36 ; PRCA*4.5*371 - Don't display details on grand total report
IF RCDET'="G"
Begin DoDot:1
+37 ; PRCA*4.5*317 Shift each line 2 chars to the right
+38 SET HCNT=HCNT+1
SET RCHDR(HCNT)=" DEPOSIT # DEPOSIT DATE TOT AMT OF DEPOSIT TOT AMT UNPOSTED"
+39 SET HCNT=HCNT+1
SET RCHDR(HCNT)=" PAYER/ID"
+40 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",4)_"TRACE #"_$JUSTIFY("",44)_"PAYMENT AMT RECEIPT #"
+41 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",6)_$EXTRACT("ERA MATCHED"_$JUSTIFY("",40),1,40)_" FMS DOC #/STATUS"
+42 ; PRCA*4.5*317 End
End DoDot:1
+43 ; row of equal signs at bottom
SET Y=""
SET $PIECE(Y,"=",81)=""
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+44 ;
+45 ; header line count
SET RCHDR(0)=HCNT
+46 QUIT
+47 ;
HDRLM ; create the report header
+1 ; returns RCHDR
+2 ; RCHDR(0) = header text line count
+3 ; INPUT:
+4 ; RCSTDT - Date Range
+5 KILL RCHDR
+6 ;
+7 NEW DIV,HCNT,Y
+8 ; header counter
SET HCNT=0
+9 SET Y="Date Range: "_$$FMTE^XLFDT(RCSTDT,2)_" - "_$$FMTE^XLFDT(RCENDT,2)_" (Deposit Date) "
+10 ; PRCA*4.5*326 ;PRCA*4.5*432 CHAMPVA
SET Y=Y_"MED/PHARM/TRIC/CHAMPVA: "
+11 ; PRCA*4.5*326 ;PRCA*4.5*432 CHAMPVA
SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")
+12 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+13 SET Y="TOTAL NUMBER OF UNAPPLIED DEPOSITS: "_RCUNAP
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+14 SET Y="TOTAL AMOUNT OF UNAPPLIED DEPOSITS: $"_$FNUMBER(RCSUM,",",2)
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+15 ;
+16 ; PRCA*4.5*317 Shift each line 2 chars to the right
+17 SET HCNT=HCNT+1
SET RCHDR(HCNT)=" DEPOSIT # DEPOSIT DATE TOT AMT OF DEPOSIT TOT AMT UNPOSTED"
+18 SET HCNT=HCNT+1
SET RCHDR(HCNT)=" PAYER/ID"
+19 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",4)_"TRACE #"_$JUSTIFY("",44)_"PAYMENT AMT RECEIPT #"
+20 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",6)_$EXTRACT("ERA MATCHED"_$JUSTIFY("",40),1,40)_" FMS DOC #/STATUS"
+21 ; PRCA*4.5*317 End
+22 ;
+23 ; header line count
SET RCHDR(0)=HCNT
+24 QUIT
+25 ;
+26 ; extrinsic variable, name for header PRCA*4.5*298
HDRNM() QUIT "Unapplied EFT Deposits Report"
+1 ;
EXCEL ; Print report formatted for export to Excel
+1 NEW STR1
+2 WRITE !,$GET(RCHDR(1)),!
+3 SET RCDT=0
FOR
SET RCDT=$ORDER(^TMP(RCRPLST,$JOB,RCDT))
if 'RCDT
QUIT
Begin DoDot:1
+4 SET RCARDEP=0
FOR
SET RCARDEP=$ORDER(^TMP(RCRPLST,$JOB,RCDT,RCARDEP))
if 'RCARDEP
QUIT
Begin DoDot:2
+5 SET RCDATA(0)=$GET(^RCY(344.3,RCARDEP,0))
+6 SET STR1=$PIECE(RCDATA(0),U,6)_$SELECT('$$HACEFT^RCDPEU(RCARDEP):"",1:"-HAC")_U_$$FMTE^XLFDT($PIECE(RCDATA(0),U,7))_U_$PIECE(RCDATA(0),U,8)_U
+7 SET STR1=STR1_+$GET(^TMP(RCRPLST,$JOB,RCDT,RCARDEP))_U
+8 SET RCEFTIEN=0
FOR
SET RCEFTIEN=$ORDER(^TMP(RCRPLST,$JOB,RCDT,RCARDEP,RCEFTIEN))
if 'RCEFTIEN
QUIT
SET RCDATA=$GET(^(RCEFTIEN))
SET RCEFT("DEP")=$GET(^RCY(344.31,RCEFTIEN,0))
Begin DoDot:3
+9 ;PRCA*4.5*298
WRITE STR1
if $PIECE(RCEFT("DEP"),U,2)=""
SET $PIECE(RCEFT("DEP"),U,2)="NO PAYER NAME RECEIVED"
+10 WRITE $PIECE(RCEFT("DEP"),U,2)_"/"_$PIECE(RCEFT("DEP"),U,3)_U_$PIECE(RCEFT("DEP"),U,4)_U
+11 WRITE +$PIECE(RCEFT("DEP"),U,7)_U_$SELECT($PIECE(RCDATA,U,4)'="":$PIECE(RCDATA,U,4),1:"NO RECEIPT")_U
+12 WRITE $PIECE(RCEFT("DEP"),U,10)_U
+13 WRITE $SELECT($PIECE(RCDATA,U)=-1:"NO RECEIPT",$PIECE(RCDATA,U)=-2:"NO FMS DOCUMENT",1:$PIECE(RCDATA,U,2)_" - "_$PIECE(RCDATA,U,3))
+14 WRITE !
End DoDot:3
End DoDot:2
End DoDot:1
if RCSTOP
QUIT
+15 QUIT
+16 ;
+17 ; PRCA*4.5*371 - Add subroutine
RDET(DEF) ; Prompt for full report or just grand total
+1 ; Input: DEF - Value to use a default
+2 ; Returns: -1 - User ^ or timed out
+3 ; D - User selected DETAIL REPORT
+4 ; G - User selected GRAND TOTAL
+5 NEW DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN
+6 SET RCTYPE=""
+7 SET DIR("?")="Enter the type of report to run"
+8 SET DIR(0)="SA^D:DETAIL;G:GRAND TOTAL"
+9 SET DIR("A")="(D)ETAIL REPORT or (G)RAND TOTAL?: "
+10 SET DIR("B")=$SELECT($GET(DEF)'="":DEF,1:"D")
+11 DO ^DIR
+12 KILL DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+14 if Y=""
QUIT "A"
+15 SET RETURN=$EXTRACT(Y)
+16 QUIT RETURN
+17 ;
