Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPLPS2

RCDPLPS2.m

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