- 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 Feb 18, 2025@23:12:31 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 ;