- 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**;Mar 20, 1995;Build 16
- ;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 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() ; 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 11986 printed Apr 23, 2025@17:59 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**;Mar 20, 1995;Build 16
- +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 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()
- +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
