RCDPLPS2 ;ALB/SAB - link payment tracking report ;5 Feb 2015
;;4.5;Accounts Receivable;**304,326**;Feb 05, 2015;Build 26
;;Per VA Directive 6402, this routine should not be modified.
Q
;
EN ;
;
;init variables
N %,RCBEGDT,RCENDFLG,RCENDDT,RCEXCEL,RCPT,RCRANGE,RCUSER
;
;Set initial values of report parameters
S RCBEGDT="",RCENDDT="",RCUSER="A",RCPT="",RCENDFLG=0
;
; PRCA*4.5*326 - Prompt for receipt number. Not required, so continue if not entered
S RCPT=$$RCPT()
I RCPT=-1 Q ; Timed out or '^'
;
I RCPT="" D I RCENDFLG Q ; PRCA*4.5*326 - Other prompts only needed if receipt was not selected
. ;get date range, quit if timed out or user wished to exit.
. S RCRANGE=$$DTRNG()
. I RCRANGE=0 S RCENDFLG=1 Q
. ;
. ;Extract begin and end date of report
. S RCBEGDT=$P(RCRANGE,U,2),RCENDDT=$P(RCRANGE,U,3)
. ;
. ;(Optional) get the AR Clerk to filter on.
. S RCUSER=$$USER()
. I RCUSER="" S RCENDFLG=1 Q
;
; PRCA*4.5*326 - Produce report for export to Microsoft Excel?
S RCEXCEL=$$DISPTY^RCDPRU() Q:+RCEXCEL=-1
I RCEXCEL D INFO^RCDPRU
;
; Parameter RCENDFLG is set if user exits
D REPORT(RCBEGDT,RCENDDT,RCUSER,RCPT,RCEXCEL,.RCENDFLG) ; PRCA*4.5*236 params RCPT, RCEXCEL and RCENDFLG
;
I 'RCENDFLG R !,"Press RETURN to continue:",%:DTIME
Q
;
; Get the date range for the report
DTRNG() ;
;
;Retrieve the date range
D DATES(.RCSTART,.RCEND)
;
;format it for use in the report
Q:RCSTART=-1 0
Q:RCSTART "1^"_RCSTART_"^"_RCEND
Q:'RCSTART "0^^"
Q 0
;
;Get start and end dates. Default is Today for the End date and 45 days from end date for the beginning date
DATES(RCBDATE,RCEDATE) ;
;
N DIR,DUOUT,RNGFLG,X,Y,DTOUT,DIROUT,DIRUT,RCTODAY
;
S RCTODAY=$$DT^XLFDT()
; Get the End date first. Assume the end date is today.
S RCBDATE=$$HTFM^XLFDT($$FMTH^XLFDT(RCTODAY)-45),RCEDATE=RCTODAY
;
;Get the start date.
S DIR("?")="ENTER THE EARLIEST AUTO POSTING DATE TO INCLUDE ON THE REPORT"
S DIR(0)="DAO^::APE",DIR("A")="START DATE: "
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S RCBDATE=-1 Q
S RCBDATE=Y
;
;Get the end date
S DIR("?")="ENTER THE LATEST AUTO POSTING DATE TO INCLUDE ON THE REPORT"
S DIR("B")=$$FMTE^XLFDT(RCTODAY,2)
S DIR(0)="DAO^"_RCBDATE_":"_RCTODAY_":APE",DIR("A")="END DATE: " D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S RCEDATE=-1 Q
S RCEDATE=Y
;
Q
;
; Ask to see if the report needs to be by a specific user. Return the IEN if
USER() ;
;
N DIR,DUOUT,RNGFLG,X,Y,RCSTART,RCEND,DTOUT,DIRUT,DIROUT
; All clerks or 1 clerk
S DIR("?")="Search on All AR Users (A), or a Single User (S)"
S DIR("B")="ALL"
S DIR(0)="SOA^S:Single User;A:All AR Users"
S DIR("A")="(S)ingle User or (A)ll Users? "
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q ""
Q:Y="A" Y
;
;If a single clerk is needed, retrieve and return.
Q $$ARCLERK
;
; Get the AR Clerk
ARCLERK() ;
;
N DIR,DUOUT,RNGFLG,X,Y,RCSTART,RCEND,DTOUT,DIRUT,DIROUT
;
S DIR("?")="ENTER AN AR USER TO SEARCH TRANSACTIONS FOR"
S DIR(0)="PA^VA(200,:AEMQ",DIR("A")="AR USER? " D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q ""
Q +Y
;
; PRCA*4.5*326 - added subroutine RCPT
RCPT() ; Prompt user for single receipt number for which to display entries
N D,DIC,DTOUT,DUOUT,RETURN,X,Y
S RETURN=""
S DIC="^RCY(344,"
S DIC(0)="AEQ"
S DIC("A")="RECEIPT NUMBER: "
S DIC("S")="I $D(^RCY(344.71,""D"",$P(^(0),U,1)))"
D ^DIC
I $D(DTOUT)!$D(DUOUT) Q -1
I Y'=-1 S RETURN=$P(Y,U,2)
Q RETURN
;
REPORT(RCBEGDT,RCENDDT,RCUSER,RCPT,RCEXCEL,RCENDFLG) ; report to show link payment audit log in FMS
N %ZIS,POP,RCDISP
;
;Select output device
S %ZIS="QM" D ^%ZIS Q:POP
;
;Option to queue
I $D(IO("Q")) D Q
.N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
.S ZTRTN="DQ^RCDPLPS2"
.S ZTDESC="EDI LOCKBOX LINK PAYMENT AUDIT LOG REPORT"
.S ZTSAVE("RC*")="",ZTSAVE("VAUTD")=""
.D ^%ZTLOAD
.I $D(ZTSK) W !!,"Task number "_ZTSK_" has been queued."
.E W !!,"Unable to queue this job."
.K ZTSK,IO("Q") D HOME^%ZIS
;
D DQ
;
Q
;
; report (queue) starts here
DQ ;
N %,PAGE,RCDATE,RCDTDIS1,RCDTDIS2,RCENTRY,RCMFST,RCMULT,RCRJFLAG,RCRJLINE,RCNOW,SCREEN,Y ; PRCA*4.5*326
;
K ^TMP("RCDPLPS2",$J)
S RCCT=0
; PRCA*4.5*326 - Begin changes
; If report is for a single receipt use the "D" cross reference
I RCPT'="" D ;
. S RCENTRY=0
. F S RCENTRY=$O(^RCY(344.71,"D",RCPT,RCENTRY)) Q:'RCENTRY D ;
. . D EXTRACT(RCENTRY,.RCCT)
;
E D ;
. ; Gather the data using the Date cross-reference, starting with the Begin date
. ; Also make sure to gather all entries from the end date.
. ;
. S RCDATE=RCBEGDT,RCENDDT=RCENDDT+.999999
. F S RCDATE=$O(^RCY(344.71,"B",RCDATE)) Q:'RCDATE Q:RCDATE>RCENDDT D
. . S RCENTRY=0
. . F S RCENTRY=$O(^RCY(344.71,"B",RCDATE,RCENTRY)) Q:'RCENTRY D
. . . D EXTRACT(RCENTRY,.RCCT)
; PRCA*4.5*326 - End changes
;
; print report
S Y=$P(RCBEGDT,".") D DD^%DT S RCDTDIS1=Y
S Y=$P(RCENDDT,".") D DD^%DT S RCDTDIS2=Y
D NOW^%DTC S Y=% D DD^%DT S RCNOW=Y
S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)=""
S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
U IO D H
S RCDATE=0
F S RCDATE=$O(^TMP("RCDPLPS2",$J,RCDATE)) Q:'RCDATE!($G(RCRJFLAG)) D
. S RCCT=0
. F S RCCT=$O(^TMP("RCDPLPS2",$J,RCDATE,RCCT)) Q:'RCCT!($G(RCRJFLAG)) D
. . S RCDATA=$G(^TMP("RCDPLPS2",$J,RCDATE,RCCT))
. . ; PRCA*4.5*326 - Export in Excel format if requested
. . S RCMULT=$S($P(RCDATA,U,8)="Multi-Trans Split":1,1:0) ; #344.711 change - PRCA*4.5*326
. . S RCMFST=+$G(^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S")) ; #344.711 change - PRCA*4.5*326
. . I RCMULT,'RCMFST Q ; #344.711 change - PRCA*4.5*326
. . I RCEXCEL D ;
. . . W $P(RCDATA,U,3)_U_$P(RCDATA,U,4)_U_$P(RCDATA,U)_U_$P(RCDATA,"^",5)_U_$P(RCDATA,U,6)_U
. . . W $P(RCDATA,U,2)_U_$P(RCDATA,U,7)_U_$P(RCDATA,U,8),!
. . . ; BEGIN #344.711 - PRCA*4.5*326
. . . Q:'RCMULT
. . . S RCSPL=0
. . . F S RCSPL=$O(^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S",RCSPL)) Q:'RCSPL D Q:$G(RCRJFLAG)
. . . . S RCDATA=$G(^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S",RCSPL)) Q:RCDATA=""
. . . . W "^^^^^^^^"_$P(RCDATA,U)_U_$P(RCDATA,U,2)_U_$P(RCDATA,U,3),!
. . . ; END #344.711 - PRCA*4.5*326
. . ; Print in report format if Excel not requested
. . E D ;
. . . I 'RCMULT W $P(RCDATA,U,3),?15,$P(RCDATA,U,4),?22,$P(RCDATA,U),?32,$J($P(RCDATA,"^",5),10,2)
. . . E W $P(RCDATA,U,3),?22,$P(RCDATA,U),?32,$J(RCMFST,10,2)
. . . ; BEGIN #344.711 - PRCA*4.5*326
. . . W ?43,$P(RCDATA,U,6),?51,$P(RCDATA,U,2),?56,$E($P(RCDATA,U,7),1,11)
. . . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. . . W:$P(RCDATA,U,8)]"" !,?5,$P(RCDATA,U,8)
. . . W !
. . . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. . . Q:'RCMULT
. . . S RCSPL=0
. . . F S RCSPL=$O(^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S",RCSPL)) Q:'RCSPL D Q:$G(RCRJFLAG)
. . . . S RCDATA=$G(^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S",RCSPL)) Q:RCDATA=""
. . . . W ?18,$P(RCDATA,U),?26,$J("$"_$J($P(RCDATA,U,2),0,2),10),?38,$E($P(RCDATA,U,3),1,40),!
. . . . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. . . ; END #344.711 - PRCA*4.5*326
; PRCA*4.5*326 - End changes
;
K ^TMP("RCDPLPS2",$J)
D ^%ZISC
S:$G(RCRJFLAG) RCENDFLG=1
I 'RCENDFLG,'RCEXCEL W !!,$$ENDORPRT^RCDPEARL
Q
;
; PRCA*4.5*326 - Add subroutine EXTRACT
; Input: RCENTRY = IEN of SUSPENSE AUDIT FILE entry (#344.71)
; Output: ^TMP("RCDPLPS2",$J) containing report data
;
N RCAMT,RCDATE,RCDATA,RCEOB,RCFLG,RCLUSER,RCRECTDA,RCREASON,RCSTATUS,RCTRANDA,RCX,RCX,RCX2,RCY,Y
;
S RCDATA=$G(^RCY(344.71,RCENTRY,0))
;
;Quit if corrupt index entry
Q:RCDATA=""
;
;Get the user. If filtering on user, quit if the user is not the filter user.
S RCLUSER=$P(RCDATA,U,2)
I RCUSER["",RCUSER'="A",RCUSER'=RCLUSER Q
;
;Update the counter
S RCCT=RCCT+1
;
;get the rest of the data
S RCDATE=$P(RCDATA,U,1) ;Date/Time of suspese entry
S RCRECTDA=$P(RCDATA,U,3) ;Receipt Number
S RCTRANDA=$P(RCDATA,U,4) ;Receipt Transaction Number
S RCAMT=$P(RCDATA,U,5) ;Amount originally placed in suspense
S RCEOB=""
S:$P(RCDATA,U,6)[";PRCA" RCEOB=$P($$GET1^DIQ(430,$P($P(RCDATA,U,6),";")_",",".01","E"),"-",2) ;Claim #
S:$P(RCDATA,U,6)[";DPT" RCEOB=$E($$GET1^DIQ(2,$P($P(RCDATA,U,6),";")_",",".01","E"),1,7) ;Pat Name
S RCSTATUS=$$GET1^DIQ(344.71,RCENTRY_",",".07","E") ;Suspense Status
S RCREASON=$P(RCDATA,U,8) ;Reason for Suspense Status
;
S RCFLG=$G(^TMP("RCDPLPS2",$J,"IDX",RCRECTDA,RCTRANDA))
;Store in the temporary array
S:RCFLG="" ^TMP("RCDPLPS2",$J,"IDX",RCRECTDA,RCTRANDA)=RCCT_"~"_RCDATE
I RCFLG'="" D
. S RCX=$P(RCFLG,U),RCX2=$P(RCX,"~",2),RCX=$P(RCX,"~"),RCY=$P(RCFLG,U,2)
. I (RCY=""),(RCREASON="Multi-Trans Split") D
. . S $P(^TMP("RCDPLPS2",$J,"IDX",RCRECTDA,RCTRANDA),U,2)=1
. . K ^TMP("RCDPLPS2",$J,RCX2,RCX)
S ^TMP("RCDPLPS2",$J,RCDATE,RCCT)=$$FMTE^XLFDT(RCDATE,"2D")_U_$$USERINIT^RCDPLPS1(RCLUSER)_U_RCRECTDA_U_RCTRANDA_U_RCAMT_U_RCEOB_U_RCSTATUS_U_RCREASON
; BEGIN #344.711 change - PRCA*4.5*326
N IENS,RCCAMT,RCCLAIM,RCCOM,RCSPL
S RCSPL=0,^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S")=0
F S RCSPL=$O(^RCY(344.71,RCENTRY,1,RCSPL)) Q:'RCSPL D
. S IENS=RCSPL_","_RCENTRY_","
. S RCCLAIM=$$GET1^DIQ(344.711,IENS,.02)
. S RCCAMT=$$GET1^DIQ(344.711,IENS,.03)
. S RCCOM=$$GET1^DIQ(344.711,IENS,.04)
. S ^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S",RCSPL)=RCCLAIM_U_RCCAMT_U_RCCOM
. S ^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S")=^TMP("RCDPLPS2",$J,RCDATE,RCCT,"S")+RCCAMT
; END #344.711 - PRCA*4.5*326
Q
H ; header
N %
I RCEXCEL D Q ; PRCA*4.5*321 - Header for EXCEL format
. W !,"RECEIPT#^TRANSACTION^DATE^AMOUNT^CLAIM^USER^DISPOSITION^REASON^CLAIMS^AMOUNT^COMMENT",! ; #344.711 - PRCA*4.5*326
;
S %=RCNOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"LINK PAYMENT TRACKING REPORT",?50,%
W !," FOR THE DATE RANGE: ",$S(RCPT="":RCDTDIS1_" TO "_RCDTDIS2,1:"")
I RCPT="" D ;
. W ?55,"FOR USER(S): ",$E($S(RCUSER="A":"ALL",1:$$GET1^DIQ(200,RCUSER_",",.01,"E")),1,10)
E D ; PRCA*4.5*321 - display receipt number in header if selected
. W ?55,"RECEIPT#: "_RCPT
W !,"RECEIPT#",?15,"TRANS#",?22,"DATE",?36,"AMOUNT",?43,"CLAIM",?51,"USER",?56,"DISPOSITION" ; #344.71 - PRCA*4.5*326
W !,?5,"REASON",?18,"CLAIMS" ; #344.71 - PRCA*4.5*326
W !,RCRJLINE,!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPLPS2 10532 printed Sep 23, 2025@19:22:16 Page 2
RCDPLPS2 ;ALB/SAB - link payment tracking report ;5 Feb 2015
+1 ;;4.5;Accounts Receivable;**304,326**;Feb 05, 2015;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
EN ;
+1 ;
+2 ;init variables
+3 NEW %,RCBEGDT,RCENDFLG,RCENDDT,RCEXCEL,RCPT,RCRANGE,RCUSER
+4 ;
+5 ;Set initial values of report parameters
+6 SET RCBEGDT=""
SET RCENDDT=""
SET RCUSER="A"
SET RCPT=""
SET RCENDFLG=0
+7 ;
+8 ; PRCA*4.5*326 - Prompt for receipt number. Not required, so continue if not entered
+9 SET RCPT=$$RCPT()
+10 ; Timed out or '^'
IF RCPT=-1
QUIT
+11 ;
+12 ; PRCA*4.5*326 - Other prompts only needed if receipt was not selected
IF RCPT=""
Begin DoDot:1
+13 ;get date range, quit if timed out or user wished to exit.
+14 SET RCRANGE=$$DTRNG()
+15 IF RCRANGE=0
SET RCENDFLG=1
QUIT
+16 ;
+17 ;Extract begin and end date of report
+18 SET RCBEGDT=$PIECE(RCRANGE,U,2)
SET RCENDDT=$PIECE(RCRANGE,U,3)
+19 ;
+20 ;(Optional) get the AR Clerk to filter on.
+21 SET RCUSER=$$USER()
+22 IF RCUSER=""
SET RCENDFLG=1
QUIT
End DoDot:1
IF RCENDFLG
QUIT
+23 ;
+24 ; PRCA*4.5*326 - Produce report for export to Microsoft Excel?
+25 SET RCEXCEL=$$DISPTY^RCDPRU()
if +RCEXCEL=-1
QUIT
+26 IF RCEXCEL
DO INFO^RCDPRU
+27 ;
+28 ; Parameter RCENDFLG is set if user exits
+29 ; PRCA*4.5*236 params RCPT, RCEXCEL and RCENDFLG
DO REPORT(RCBEGDT,RCENDDT,RCUSER,RCPT,RCEXCEL,.RCENDFLG)
+30 ;
+31 IF 'RCENDFLG
READ !,"Press RETURN to continue:",%:DTIME
+32 QUIT
+33 ;
+34 ; Get the date range for the report
DTRNG() ;
+1 ;
+2 ;Retrieve the date range
+3 DO DATES(.RCSTART,.RCEND)
+4 ;
+5 ;format it for use in the report
+6 if RCSTART=-1
QUIT 0
+7 if RCSTART
QUIT "1^"_RCSTART_"^"_RCEND
+8 if 'RCSTART
QUIT "0^^"
+9 QUIT 0
+10 ;
+11 ;Get start and end dates. Default is Today for the End date and 45 days from end date for the beginning date
DATES(RCBDATE,RCEDATE) ;
+1 ;
+2 NEW DIR,DUOUT,RNGFLG,X,Y,DTOUT,DIROUT,DIRUT,RCTODAY
+3 ;
+4 SET RCTODAY=$$DT^XLFDT()
+5 ; Get the End date first. Assume the end date is today.
+6 SET RCBDATE=$$HTFM^XLFDT($$FMTH^XLFDT(RCTODAY)-45)
SET RCEDATE=RCTODAY
+7 ;
+8 ;Get the start date.
+9 SET DIR("?")="ENTER THE EARLIEST AUTO POSTING DATE TO INCLUDE ON THE REPORT"
+10 SET DIR(0)="DAO^::APE"
SET DIR("A")="START DATE: "
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET RCBDATE=-1
QUIT
+13 SET RCBDATE=Y
+14 ;
+15 ;Get the end date
+16 SET DIR("?")="ENTER THE LATEST AUTO POSTING DATE TO INCLUDE ON THE REPORT"
+17 SET DIR("B")=$$FMTE^XLFDT(RCTODAY,2)
+18 SET DIR(0)="DAO^"_RCBDATE_":"_RCTODAY_":APE"
SET DIR("A")="END DATE: "
DO ^DIR
KILL DIR
+19 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET RCEDATE=-1
QUIT
+20 SET RCEDATE=Y
+21 ;
+22 QUIT
+23 ;
+24 ; Ask to see if the report needs to be by a specific user. Return the IEN if
USER() ;
+1 ;
+2 NEW DIR,DUOUT,RNGFLG,X,Y,RCSTART,RCEND,DTOUT,DIRUT,DIROUT
+3 ; All clerks or 1 clerk
+4 SET DIR("?")="Search on All AR Users (A), or a Single User (S)"
+5 SET DIR("B")="ALL"
+6 SET DIR(0)="SOA^S:Single User;A:All AR Users"
+7 SET DIR("A")="(S)ingle User or (A)ll Users? "
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT ""
+10 if Y="A"
QUIT Y
+11 ;
+12 ;If a single clerk is needed, retrieve and return.
+13 QUIT $$ARCLERK
+14 ;
+15 ; Get the AR Clerk
ARCLERK() ;
+1 ;
+2 NEW DIR,DUOUT,RNGFLG,X,Y,RCSTART,RCEND,DTOUT,DIRUT,DIROUT
+3 ;
+4 SET DIR("?")="ENTER AN AR USER TO SEARCH TRANSACTIONS FOR"
+5 SET DIR(0)="PA^VA(200,:AEMQ"
SET DIR("A")="AR USER? "
DO ^DIR
KILL DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT ""
+7 QUIT +Y
+8 ;
+9 ; PRCA*4.5*326 - added subroutine RCPT
RCPT() ; Prompt user for single receipt number for which to display entries
+1 NEW D,DIC,DTOUT,DUOUT,RETURN,X,Y
+2 SET RETURN=""
+3 SET DIC="^RCY(344,"
+4 SET DIC(0)="AEQ"
+5 SET DIC("A")="RECEIPT NUMBER: "
+6 SET DIC("S")="I $D(^RCY(344.71,""D"",$P(^(0),U,1)))"
+7 DO ^DIC
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+9 IF Y'=-1
SET RETURN=$PIECE(Y,U,2)
+10 QUIT RETURN
+11 ;
REPORT(RCBEGDT,RCENDDT,RCUSER,RCPT,RCEXCEL,RCENDFLG) ; report to show link payment audit log in FMS
+1 NEW %ZIS,POP,RCDISP
+2 ;
+3 ;Select output device
+4 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+5 ;
+6 ;Option to queue
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+9 SET ZTRTN="DQ^RCDPLPS2"
+10 SET ZTDESC="EDI LOCKBOX LINK PAYMENT AUDIT LOG REPORT"
+11 SET ZTSAVE("RC*")=""
SET ZTSAVE("VAUTD")=""
+12 DO ^%ZTLOAD
+13 IF $DATA(ZTSK)
WRITE !!,"Task number "_ZTSK_" has been queued."
+14 IF '$TEST
WRITE !!,"Unable to queue this job."
+15 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+16 ;
+17 DO DQ
+18 ;
+19 QUIT
+20 ;
+21 ; report (queue) starts here
DQ ;
+1 ; PRCA*4.5*326
NEW %,PAGE,RCDATE,RCDTDIS1,RCDTDIS2,RCENTRY,RCMFST,RCMULT,RCRJFLAG,RCRJLINE,RCNOW,SCREEN,Y
+2 ;
+3 KILL ^TMP("RCDPLPS2",$JOB)
+4 SET RCCT=0
+5 ; PRCA*4.5*326 - Begin changes
+6 ; If report is for a single receipt use the "D" cross reference
+7 ;
IF RCPT'=""
Begin DoDot:1
+8 SET RCENTRY=0
+9 ;
FOR
SET RCENTRY=$ORDER(^RCY(344.71,"D",RCPT,RCENTRY))
if 'RCENTRY
QUIT
Begin DoDot:2
+10 DO EXTRACT(RCENTRY,.RCCT)
End DoDot:2
End DoDot:1
+11 ;
+12 ;
IF '$TEST
Begin DoDot:1
+13 ; Gather the data using the Date cross-reference, starting with the Begin date
+14 ; Also make sure to gather all entries from the end date.
+15 ;
+16 SET RCDATE=RCBEGDT
SET RCENDDT=RCENDDT+.999999
+17 FOR
SET RCDATE=$ORDER(^RCY(344.71,"B",RCDATE))
if 'RCDATE
QUIT
if RCDATE>RCENDDT
QUIT
Begin DoDot:2
+18 SET RCENTRY=0
+19 FOR
SET RCENTRY=$ORDER(^RCY(344.71,"B",RCDATE,RCENTRY))
if 'RCENTRY
QUIT
Begin DoDot:3
+20 DO EXTRACT(RCENTRY,.RCCT)
End DoDot:3
End DoDot:2
End DoDot:1
+21 ; PRCA*4.5*326 - End changes
+22 ;
+23 ; print report
+24 SET Y=$PIECE(RCBEGDT,".")
DO DD^%DT
SET RCDTDIS1=Y
+25 SET Y=$PIECE(RCENDDT,".")
DO DD^%DT
SET RCDTDIS2=Y
+26 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET RCNOW=Y
+27 SET PAGE=1
SET RCRJLINE=""
SET $PIECE(RCRJLINE,"-",81)=""
+28 SET SCREEN=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET SCREEN=1
+29 USE IO
DO H
+30 SET RCDATE=0
+31 FOR
SET RCDATE=$ORDER(^TMP("RCDPLPS2",$JOB,RCDATE))
if 'RCDATE!($GET(RCRJFLAG))
QUIT
Begin DoDot:1
+32 SET RCCT=0
+33 FOR
SET RCCT=$ORDER(^TMP("RCDPLPS2",$JOB,RCDATE,RCCT))
if 'RCCT!($GET(RCRJFLAG))
QUIT
Begin DoDot:2
+34 SET RCDATA=$GET(^TMP("RCDPLPS2",$JOB,RCDATE,RCCT))
+35 ; PRCA*4.5*326 - Export in Excel format if requested
+36 ; #344.711 change - PRCA*4.5*326
SET RCMULT=$SELECT($PIECE(RCDATA,U,8)="Multi-Trans Split":1,1:0)
+37 ; #344.711 change - PRCA*4.5*326
SET RCMFST=+$GET(^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S"))
+38 ; #344.711 change - PRCA*4.5*326
IF RCMULT
IF 'RCMFST
QUIT
+39 ;
IF RCEXCEL
Begin DoDot:3
+40 WRITE $PIECE(RCDATA,U,3)_U_$PIECE(RCDATA,U,4)_U_$PIECE(RCDATA,U)_U_$PIECE(RCDATA,"^",5)_U_$PIECE(RCDATA,U,6)_U
+41 WRITE $PIECE(RCDATA,U,2)_U_$PIECE(RCDATA,U,7)_U_$PIECE(RCDATA,U,8),!
+42 ; BEGIN #344.711 - PRCA*4.5*326
+43 if 'RCMULT
QUIT
+44 SET RCSPL=0
+45 FOR
SET RCSPL=$ORDER(^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S",RCSPL))
if 'RCSPL
QUIT
Begin DoDot:4
+46 SET RCDATA=$GET(^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S",RCSPL))
if RCDATA=""
QUIT
+47 WRITE "^^^^^^^^"_$PIECE(RCDATA,U)_U_$PIECE(RCDATA,U,2)_U_$PIECE(RCDATA,U,3),!
End DoDot:4
if $GET(RCRJFLAG)
QUIT
+48 ; END #344.711 - PRCA*4.5*326
End DoDot:3
+49 ; Print in report format if Excel not requested
+50 ;
IF '$TEST
Begin DoDot:3
+51 IF 'RCMULT
WRITE $PIECE(RCDATA,U,3),?15,$PIECE(RCDATA,U,4),?22,$PIECE(RCDATA,U),?32,$JUSTIFY($PIECE(RCDATA,"^",5),10,2)
+52 IF '$TEST
WRITE $PIECE(RCDATA,U,3),?22,$PIECE(RCDATA,U),?32,$JUSTIFY(RCMFST,10,2)
+53 ; BEGIN #344.711 - PRCA*4.5*326
+54 WRITE ?43,$PIECE(RCDATA,U,6),?51,$PIECE(RCDATA,U,2),?56,$EXTRACT($PIECE(RCDATA,U,7),1,11)
+55 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+56 if $PIECE(RCDATA,U,8)]""
WRITE !,?5,$PIECE(RCDATA,U,8)
+57 WRITE !
+58 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+59 if 'RCMULT
QUIT
+60 SET RCSPL=0
+61 FOR
SET RCSPL=$ORDER(^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S",RCSPL))
if 'RCSPL
QUIT
Begin DoDot:4
+62 SET RCDATA=$GET(^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S",RCSPL))
if RCDATA=""
QUIT
+63 WRITE ?18,$PIECE(RCDATA,U),?26,$JUSTIFY("$"_$JUSTIFY($PIECE(RCDATA,U,2),0,2),10),?38,$EXTRACT($PIECE(RCDATA,U,3),1,40),!
+64 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
End DoDot:4
if $GET(RCRJFLAG)
QUIT
+65 ; END #344.711 - PRCA*4.5*326
End DoDot:3
End DoDot:2
End DoDot:1
+66 ; PRCA*4.5*326 - End changes
+67 ;
+68 KILL ^TMP("RCDPLPS2",$JOB)
+69 DO ^%ZISC
+70 if $GET(RCRJFLAG)
SET RCENDFLG=1
+71 IF 'RCENDFLG
IF 'RCEXCEL
WRITE !!,$$ENDORPRT^RCDPEARL
+72 QUIT
+73 ;
+74 ; PRCA*4.5*326 - Add subroutine EXTRACT
+1 ; Input: RCENTRY = IEN of SUSPENSE AUDIT FILE entry (#344.71)
+2 ; Output: ^TMP("RCDPLPS2",$J) containing report data
+3 ;
+4 NEW RCAMT,RCDATE,RCDATA,RCEOB,RCFLG,RCLUSER,RCRECTDA,RCREASON,RCSTATUS,RCTRANDA,RCX,RCX,RCX2,RCY,Y
+5 ;
+6 SET RCDATA=$GET(^RCY(344.71,RCENTRY,0))
+7 ;
+8 ;Quit if corrupt index entry
+9 if RCDATA=""
QUIT
+10 ;
+11 ;Get the user. If filtering on user, quit if the user is not the filter user.
+12 SET RCLUSER=$PIECE(RCDATA,U,2)
+13 IF RCUSER[""
IF RCUSER'="A"
IF RCUSER'=RCLUSER
QUIT
+14 ;
+15 ;Update the counter
+16 SET RCCT=RCCT+1
+17 ;
+18 ;get the rest of the data
+19 ;Date/Time of suspese entry
SET RCDATE=$PIECE(RCDATA,U,1)
+20 ;Receipt Number
SET RCRECTDA=$PIECE(RCDATA,U,3)
+21 ;Receipt Transaction Number
SET RCTRANDA=$PIECE(RCDATA,U,4)
+22 ;Amount originally placed in suspense
SET RCAMT=$PIECE(RCDATA,U,5)
+23 SET RCEOB=""
+24 ;Claim #
if $PIECE(RCDATA,U,6)[";PRCA"
SET RCEOB=$PIECE($$GET1^DIQ(430,$PIECE($PIECE(RCDATA,U,6),";")_",",".01","E"),"-",2)
+25 ;Pat Name
if $PIECE(RCDATA,U,6)[";DPT"
SET RCEOB=$EXTRACT($$GET1^DIQ(2,$PIECE($PIECE(RCDATA,U,6),";")_",",".01","E"),1,7)
+26 ;Suspense Status
SET RCSTATUS=$$GET1^DIQ(344.71,RCENTRY_",",".07","E")
+27 ;Reason for Suspense Status
SET RCREASON=$PIECE(RCDATA,U,8)
+28 ;
+29 SET RCFLG=$GET(^TMP("RCDPLPS2",$JOB,"IDX",RCRECTDA,RCTRANDA))
+30 ;Store in the temporary array
+31 if RCFLG=""
SET ^TMP("RCDPLPS2",$JOB,"IDX",RCRECTDA,RCTRANDA)=RCCT_"~"_RCDATE
+32 IF RCFLG'=""
Begin DoDot:1
+33 SET RCX=$PIECE(RCFLG,U)
SET RCX2=$PIECE(RCX,"~",2)
SET RCX=$PIECE(RCX,"~")
SET RCY=$PIECE(RCFLG,U,2)
+34 IF (RCY="")
IF (RCREASON="Multi-Trans Split")
Begin DoDot:2
+35 SET $PIECE(^TMP("RCDPLPS2",$JOB,"IDX",RCRECTDA,RCTRANDA),U,2)=1
+36 KILL ^TMP("RCDPLPS2",$JOB,RCX2,RCX)
End DoDot:2
End DoDot:1
+37 SET ^TMP("RCDPLPS2",$JOB,RCDATE,RCCT)=$$FMTE^XLFDT(RCDATE,"2D")_U_$$USERINIT^RCDPLPS1(RCLUSER)_U_RCRECTDA_U_RCTRANDA_U_RCAMT_U_RCEOB_U_RCSTATUS_U_RCREASON
+38 ; BEGIN #344.711 change - PRCA*4.5*326
+39 NEW IENS,RCCAMT,RCCLAIM,RCCOM,RCSPL
+40 SET RCSPL=0
SET ^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S")=0
+41 FOR
SET RCSPL=$ORDER(^RCY(344.71,RCENTRY,1,RCSPL))
if 'RCSPL
QUIT
Begin DoDot:1
+42 SET IENS=RCSPL_","_RCENTRY_","
+43 SET RCCLAIM=$$GET1^DIQ(344.711,IENS,.02)
+44 SET RCCAMT=$$GET1^DIQ(344.711,IENS,.03)
+45 SET RCCOM=$$GET1^DIQ(344.711,IENS,.04)
+46 SET ^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S",RCSPL)=RCCLAIM_U_RCCAMT_U_RCCOM
+47 SET ^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S")=^TMP("RCDPLPS2",$JOB,RCDATE,RCCT,"S")+RCCAMT
End DoDot:1
+48 ; END #344.711 - PRCA*4.5*326
+49 QUIT
H ; header
+1 NEW %
+2 ; PRCA*4.5*321 - Header for EXCEL format
IF RCEXCEL
Begin DoDot:1
+3 ; #344.711 - PRCA*4.5*326
WRITE !,"RECEIPT#^TRANSACTION^DATE^AMOUNT^CLAIM^USER^DISPOSITION^REASON^CLAIMS^AMOUNT^COMMENT",!
End DoDot:1
QUIT
+4 ;
+5 SET %=RCNOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+6 WRITE $CHAR(13),"LINK PAYMENT TRACKING REPORT",?50,%
+7 WRITE !," FOR THE DATE RANGE: ",$SELECT(RCPT="":RCDTDIS1_" TO "_RCDTDIS2,1:"")
+8 ;
IF RCPT=""
Begin DoDot:1
+9 WRITE ?55,"FOR USER(S): ",$EXTRACT($SELECT(RCUSER="A":"ALL",1:$$GET1^DIQ(200,RCUSER_",",.01,"E")),1,10)
End DoDot:1
+10 ; PRCA*4.5*321 - display receipt number in header if selected
IF '$TEST
Begin DoDot:1
+11 WRITE ?55,"RECEIPT#: "_RCPT
End DoDot:1
+12 ; #344.71 - PRCA*4.5*326
WRITE !,"RECEIPT#",?15,"TRANS#",?22,"DATE",?36,"AMOUNT",?43,"CLAIM",?51,"USER",?56,"DISPOSITION"
+13 ; #344.71 - PRCA*4.5*326
WRITE !,?5,"REASON",?18,"CLAIMS"
+14 WRITE !,RCRJLINE,!
+15 QUIT
+16 ;
