RCDPEDAR ;ALB/TMK - ACTIVITY REPORT ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,276,284,283,298,304,318,321,326**;Mar 20, 1995;Build 26
;Per VA Directive 6402, this routine should not be modified.
Q
;
RPT ; Daily Activity Rpt On Demand
N POP,RCDET,RCDIV,RCDONLY,RCDT1,RCDT2,RCHDR,RCINC,RCLSTMGR,RCNJ
N RCPAR,RCPAY,RCPYRSEL,RCRANGE,RCSTOP,RCTMPND,RCTYPE,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() ; Select Report Type (Summary/Detail)
Q:RCDET=-1
S XX=$$DTRANGE(.RCDT1,.RCDT2) ; Select Date Range to be used
Q:'XX
;
; PRCA*4.5*326 - Ask to show Medical/Pharmacy Tricare 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() ; Debit only filter ;PRCA*4.5*321
Q:RCDONLY=-1 ; '^' or timeout
S RCLSTMGR=$$ASKLM^RCDPEARL ; Ask to Display in Listman Template
Q:RCLSTMGR<0 ; '^' or timeout
;
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)
. 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_")" ;PRCA*4.5*321 added RCDONLY
. 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)
Q
;
DBTONLY() ; Allows the user to select filter to only show EFTs with debits
; PRCA*4.5*321 Added subroutine
; Input: None
; Returns: 0 - All EFTs to display
; 1 - Only EFTs with debits to be displayed
; -1 - User up-arrowed or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR("A")="Show EFTs with debits only? "
S DIR(0)="SA^Y:YES;N:NO"
S DIR("B")="NO"
S DIR("?",1)="Enter 'YES' to only show EFTs with a debit flag of 'D'."
S DIR("?")="Enter 'NO' to show all EFTs."
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
Q $E(Y,1)="Y"
;
RTYPE() ; Allows the user to select the report type (Summary/Detail)
; Input: None
; Returns: 0 - Summary Display
; 1 - Detail Display
; -1 - User up-arrowed or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR("A")="(S)UMMARY OR (D)ETAIL?: "
S DIR(0)="SA^S:SUMMARY TOTALS ONLY;D:DETAIL AND TOTALS"
S DIR("B")="D"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
Q Y="D"
;
DTRANGE(STDATE,ENDDATE) ; Allows the user to select the date range to by used
; Input: None
; Output: STDATE = Internal Fileman Date to start at
; ENDDATE - Internal Fileman Date to end at
; Returns: 0 - User up-arrowed or timed out, 1 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR("?")="Enter the earliest date of receipt of deposit to include on the report."
S DIR(0)="DAO^:"_DT_":APE"
S DIR("A")="START DATE: "
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!(Y="") 0
S STDATE=Y
K DIR
S DIR("?")="Enter the latest date of receipt of deposit to include on the report."
S DIR("B")=Y(0)
S DIR(0)="DAO^"_RCDT1_":"_DT_":APE",DIR("A")="END DATE: "
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!(Y="") 0
S ENDDATE=Y
Q 1
;
EN(RCDET,RCDT1,RCDT2,RCLSTMGR,DONLY) ; 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
; 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,RCFLG,RCJOB,RCT,XX,Z ; PRCA*4.5*321 Added DFLG
N:$G(ZTSK) ZTSTOP ; Job was tasked, ZTSTOP = flag to stop
S:'$D(RCLSTMGR) RCLSTMGR=0
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
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
. . 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
. D RPT1(.INPUT)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEDAR 11974 printed Apr 09, 2024@20:52:43 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**;Mar 20, 1995;Build 26
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
RPT ; Daily Activity Rpt On Demand
+1 NEW POP,RCDET,RCDIV,RCDONLY,RCDT1,RCDT2,RCHDR,RCINC,RCLSTMGR,RCNJ
+2 NEW RCPAR,RCPAY,RCPYRSEL,RCRANGE,RCSTOP,RCTMPND,RCTYPE,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()
+7 if RCDET=-1
QUIT
+8 ; Select Date Range to be used
SET XX=$$DTRANGE(.RCDT1,.RCDT2)
+9 if 'XX
QUIT
+10 ;
+11 ; PRCA*4.5*326 - Ask to show Medical/Pharmacy Tricare 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()
+26 ; '^' or timeout
if RCDONLY=-1
QUIT
+27 ; Ask to Display in Listman Template
SET RCLSTMGR=$$ASKLM^RCDPEARL
+28 ; '^' or timeout
if RCLSTMGR<0
QUIT
+29 ;
+30 ; ListMan Template format, put in array
IF RCLSTMGR=1
Begin DoDot:1
+31 SET RCTMPND="RCDPE_DAR"
+32 KILL ^TMP($JOB,RCTMPND)
+33 DO EN(RCDET,RCDT1,RCDT2,RCLSTMGR,RCDONLY)
+34 DO LMHDR^RCDPEDA4(.RCSTOP,RCDET,1,RCDT1,RCDT2,.RCHDR,RCDONLY)
+35 ; Generate ListMan display
DO LMRPT^RCDPEARL(.RCHDR,$NAME(^TMP($JOB,RCTMPND)))
+36 KILL ^TMP($JOB,RCTMPND)
End DoDot:1
QUIT
+37 ;
+38 ; Ask device
+39 SET %ZIS="QM"
+40 DO ^%ZIS
+41 if POP
QUIT
+42 ;
+43 ; Queued Report
IF $DATA(IO("Q"))
Begin DoDot:1
+44 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+45 ;PRCA*4.5*321 added RCDONLY
SET ZTRTN="EN^RCDPEDAR("_RCDET_","_RCDT1_","_RCDT2_",0,"_RCDONLY_")"
+46 SET ZTDESC="AR - EDI LOCKBOX EFT DAILY ACTIVITY REPORT"
+47 SET ZTSAVE("RC*")=""
SET ZTSAVE("VAUTD")=""
+48 ; PRCA*4.5*326
SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
+49 ;
+50 DO ^%ZTLOAD
+51 WRITE !!,$SELECT($DATA(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
+52 KILL ZTSK,IO("Q")
+53 DO HOME^%ZIS
End DoDot:1
QUIT
+54 ;
+55 USE IO
+56 DO EN(RCDET,RCDT1,RCDT2,RCLSTMGR,RCDONLY)
+57 QUIT
+58 ;
DBTONLY() ; Allows the user to select filter to only show EFTs with debits
+1 ; PRCA*4.5*321 Added subroutine
+2 ; Input: None
+3 ; Returns: 0 - All EFTs to display
+4 ; 1 - Only EFTs with debits to be displayed
+5 ; -1 - User up-arrowed or timed out
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+7 SET DIR("A")="Show EFTs with debits only? "
+8 SET DIR(0)="SA^Y:YES;N:NO"
+9 SET DIR("B")="NO"
+10 SET DIR("?",1)="Enter 'YES' to only show EFTs with a debit flag of 'D'."
+11 SET DIR("?")="Enter 'NO' to show all EFTs."
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+14 QUIT $EXTRACT(Y,1)="Y"
+15 ;
RTYPE() ; Allows the user to select the report type (Summary/Detail)
+1 ; Input: None
+2 ; Returns: 0 - Summary Display
+3 ; 1 - Detail Display
+4 ; -1 - User up-arrowed or timed out
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+6 SET DIR("A")="(S)UMMARY OR (D)ETAIL?: "
+7 SET DIR(0)="SA^S:SUMMARY TOTALS ONLY;D:DETAIL AND TOTALS"
+8 SET DIR("B")="D"
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+11 QUIT Y="D"
+12 ;
DTRANGE(STDATE,ENDDATE) ; Allows the user to select the date range to by used
+1 ; Input: None
+2 ; Output: STDATE = Internal Fileman Date to start at
+3 ; ENDDATE - Internal Fileman Date to end at
+4 ; Returns: 0 - User up-arrowed or timed out, 1 otherwise
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+6 SET DIR("?")="Enter the earliest date of receipt of deposit to include on the report."
+7 SET DIR(0)="DAO^:"_DT_":APE"
+8 SET DIR("A")="START DATE: "
+9 DO ^DIR
+10 if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+11 SET STDATE=Y
+12 KILL DIR
+13 SET DIR("?")="Enter the latest date of receipt of deposit to include on the report."
+14 SET DIR("B")=Y(0)
+15 SET DIR(0)="DAO^"_RCDT1_":"_DT_":APE"
SET DIR("A")="END DATE: "
+16 DO ^DIR
+17 if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+18 SET ENDDATE=Y
+19 QUIT 1
+20 ;
EN(RCDET,RCDT1,RCDT2,RCLSTMGR,DONLY) ; 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 ; RCPAY - A - All Payers selected
+9 ; - R - Range of Payers
+10 ; - S - Specific payers
+11 ; RCPYRSEL - Array of selected payers (Only present if A1=3 above
+12 ; VAUTD - 1 - All selected divisions OR an array of selected divisions
+13 ; PRCA*4.5*321 Added DFLG
NEW DFLG,DTADD,IEN3443,IEN34431,INPUT,RCFLG,RCJOB,RCT,XX,Z
+14 ; Job was tasked, ZTSTOP = flag to stop
if $GET(ZTSK)
NEW ZTSTOP
+15 if '$DATA(RCLSTMGR)
SET RCLSTMGR=0
+16 ; PRCA*4.5*326
SET RCPAY=$GET(RCPAY,"A")
+17 ;
+18 SET XX=$SELECT(RCLSTMGR:1,1:0)
+19 SET INPUT=XX_"^"_RCLSTMGR_"^"_+RCDET
+20 SET RCJOB=$JOB
+21 KILL ^TMP("RCDAILYACT",$JOB)
+22 ; Initialize Totals temp workspace
KILL ^TMP($JOB,"TOTALS")
+23 ;
+24 ; Loop through all of the EDI LOCKBOX DEPOSIT records in the selected date
+25 ; range and add any that pass the payer and division filters into ^TMP
+26 ; by the internal date added
+27 SET DTADD=RCDT1-.0001
SET RCT=0
+28 ; Current Page Number
SET $PIECE(INPUT,"^",4)=0
+29 ; Stop Flag
SET $PIECE(INPUT,"^",5)=0
+30 SET $PIECE(INPUT,"^",10)=DONLY
+31 FOR
Begin DoDot:1
+32 SET DTADD=$ORDER(^RCY(344.3,"ARECDT",DTADD))
+33 if 'DTADD
QUIT
+34 if DTADD>(RCDT2_".9999")
QUIT
+35 SET IEN3443=0
+36 FOR
Begin DoDot:2
+37 SET IEN3443=$ORDER(^RCY(344.3,"ARECDT",DTADD,IEN3443))
+38 if 'IEN3443
QUIT
+39 SET IEN34431=""
SET RCFLG=0
+40 FOR
Begin DoDot:3
+41 SET IEN34431=$ORDER(^RCY(344.31,"B",IEN3443,IEN34431))
+42 if IEN34431=""
QUIT
+43 ;
+44 IF RCPAY'="A"
Begin DoDot:4
+45 ; PRCA*4.5*326 Check if payer was selected
SET XX=$$ISSEL^RCDPEU1(344.31,IEN34431)
End DoDot:4
if 'XX
QUIT
+46 ; If all of a given type of payer selected
IF RCTYPE'="A"
Begin DoDot:4
+47 ; check that payer matches type
SET XX=$$ISTYPE^RCDPEU1(344.31,IEN34431,RCTYPE)
End DoDot:4
if 'XX
QUIT
+48 ;
+49 ; Not a selected station/division
if '$$CHKDIV(IEN34431,0,.VAUTD)
QUIT
+50 ;
+51 ; PRCA*4.5*321 Added filter for Debit EFTs Only below
+52 ; Not an EFT with a debit flag of 'D'
IF DONLY
Begin DoDot:4
+53 SET DFLG=$$GET1^DIQ(344.31,IEN34431,3,"E")
End DoDot:4
if DFLG'="D"
QUIT
+54 SET RCFLG=1
+55 SET ^TMP("RCDAILYACT",$JOB,DTADD\1,IEN3443,"EFT",IEN34431)=""
End DoDot:3
if IEN34431=""
QUIT
+56 ;
+57 if RCFLG
SET ^TMP("RCDAILYACT",$JOB,DTADD\1,IEN3443)=""
+58 ; Current Record Count
SET RCT=RCT+1
+59 ;
+60 ; Check for user stopped every 100 records
+61 IF '(RCT#100)
IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
Begin DoDot:3
+62 SET ZTSTOP=1
+63 ; Stop now
SET $PIECE(INPUT,"^",5)=1
+64 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
+65 ;
+66 IF '$PIECE(INPUT,"^",5)
Begin DoDot:1
+67 ; Start of Date Range
SET $PIECE(INPUT,"^",6)=RCDT1
+68 ; End of Date Range
SET $PIECE(INPUT,"^",7)=RCDT2
+69 DO RPT1(.INPUT)
End DoDot:1
+70 DO ENQ(INPUT)
+71 QUIT
+72 ;
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
