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

RCDPRLIS.m

Go to the documentation of this file.
  1. RCDPRLIS ;WISC/RFJ - list of receipts report ;1 Jun 99
  1. ;;4.5;Accounts Receivable;**114,304,321,332,349**;Mar 20, 1995;Build 44
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. N %ZIS,DATEEND,DATESTRT,POP,RCFILTF,RCFILTT,RCLSTMGR,RCSORT
  1. N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
  1. W !
  1. D DATESEL^RCRJRTRA("RECEIPT Opened")
  1. I '$G(DATESTRT)!('$G(DATEEND)) Q
  1. ;
  1. ; Prompt for sort order PRCA*4.5*321
  1. S RCSORT=$$SORTSEL()
  1. I RCSORT=-1 Q
  1. ;
  1. ; Prompt for filter by FMS Status PRCA*4.5*321
  1. D SELFILTF(.RCFILTF)
  1. I RCFILTF=-1 Q
  1. ;
  1. ; Prompt for filter by Payment Type PRCA*4.5*321
  1. D SELFILTT(.RCFILTT)
  1. I RCFILTT=-1 Q
  1. ;
  1. ; Ask for ListMan display, exit if timeout or '^'
  1. W !
  1. S RCLSTMGR=$$ASKLM^RCDPEARL() I RCLSTMGR<0 Q
  1. ;
  1. ; Send report to Listman if requested
  1. I RCLSTMGR D D CLEAN Q
  1. . D DQ
  1. . D EN^RCDPRL
  1. ;
  1. ; select device
  1. W ! S %ZIS="Q" D ^%ZIS I POP Q
  1. I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
  1. . S ZTDESC="List of Receipts",ZTRTN="DQ^RCDPRLIS"
  1. . S ZTSAVE("DATE*")="",ZTSAVE("RC*")="",ZTSAVE("ZTREQ")="@"
  1. W !!,"<*> please wait <*>"
  1. D DQ
  1. Q
  1. ;
  1. DQ ; queued report starts here
  1. ; PRCA*4.5*321 Extensive changes to this subroutine for filter/sort/ListMan
  1. N %,%I,CNT,DATA,DATE,DATEDIS1,DATEDIS2,FMSDOCNO,FMSTATUS,NOW,PAGE,PTYPE,RCDK,RCDPDATA
  1. ;
  1. ; PRCA*4.5*349 - Added RCTTL
  1. N RCDPFPRE,RCIX,RCRECTDA,RCRJFLAG,RCRJLINE,RCTTL,RCUSER,SCREEN,SPACE,TOTALS,TYPE,X,XX,Y,ZZ ; PRCA*4.5*332
  1. K ^TMP($J,"RCDPRLIS")
  1. S SPACE=$J("",80)
  1. S RCDK=$$FMADD^XLFDT(DATESTRT,-1)_".24" ; Initialize start date for first $ORDER
  1. S DATEEND=DATEEND_".24" ; Receipt date opened can include time, so compare with midnight on the end date.
  1. F S RCDK=$O(^RCY(344,"AO",RCDK)) Q:(RCDK=""!(RCDK>DATEEND)) D ;
  1. . S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AO",RCDK,RCRECTDA)) Q:'RCRECTDA D
  1. . . K RCDPDATA
  1. . . D DIQ344^RCDPRPLM(RCRECTDA,".01:200")
  1. . . S FMSDOCNO=$$FMSSTAT^RCDPUREC(RCRECTDA) ; get FMS Document^Status^Pre lockbox patch
  1. . . S FMSTATUS=$P(FMSDOCNO,"^",2) ; Apply filter by FMS Status
  1. . . I RCFILTF,FMSTATUS'="",'$D(RCFILTF(FMSTATUS)) Q ; Status not included
  1. . . S PTYPE=RCDPDATA(344,RCRECTDA,.04,"E") ; Apply filter by Payment Type
  1. . . I RCFILTT,PTYPE'="",'$D(RCFILTT(PTYPE)) Q ; Status not included
  1. . . S RCTTL=$$RCPTTL(RCRECTDA) ; PRCA*4.5*349 - Total of receipt
  1. . . ;
  1. . . ; Compute totals by type
  1. . . I RCDPDATA(344,RCRECTDA,.04,"E")="" S RCDPDATA(344,RCRECTDA,.04,"E")="UNKNOWN"
  1. . . S $P(TOTALS(PTYPE),"^",1)=$P($G(TOTALS(PTYPE)),"^",1)+RCDPDATA(344,RCRECTDA,101,"E")
  1. . . ;
  1. . . ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
  1. . . S $P(TOTALS(PTYPE),"^",2)=$P($G(TOTALS(PTYPE)),"^",2)+RCTTL
  1. . . S $P(TOTALS,"^",1)=$P($G(TOTALS),"^",1)+RCDPDATA(344,RCRECTDA,101,"E")
  1. . . ;
  1. . . ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
  1. . . S $P(TOTALS,"^",2)=$P($G(TOTALS),"^",2)+RCTTL
  1. . . ;
  1. . . I RCDPDATA(344,RCRECTDA,.02,"I")=.5 D ; Opened by
  1. . . . S RCUSER="ar"
  1. . . ; PRCA*4.5*332 Begin modified code block
  1. . . E D ;
  1. . . . S RCUSER=RCDPDATA(344,RCRECTDA,.02,"E")
  1. . . . I RCUSER'="" D
  1. . . . . S RCUSER=$E($P(RCUSER,",",1),1,5)_","_$E($P(RCUSER,",",2),1)
  1. . . ;
  1. . . S DATA=RCDPDATA(344,RCRECTDA,.01,"E") ; Receipt number
  1. . . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,.03,"I") ; Date opened
  1. . . S ZZ=$$TYPE(RCDPDATA(344,RCRECTDA,.04,"E")) ; Payment type
  1. . . S DATA=DATA_"^"_ZZ ; Payment type
  1. . . S DATA=DATA_"^"_RCUSER ; User initials
  1. . . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,101,"E") ; Payment count
  1. . . ;
  1. . . ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
  1. . . S DATA=DATA_"^"_RCTTL ; Payment amount
  1. . . S DATA=DATA_"^"_$S($P(FMSDOCNO,"^",3):"*",1:" ") ; Pre lockbox
  1. . . S DATA=DATA_"^"_$P(FMSDOCNO,"^") ; FMS CR document
  1. . . S ZZ=$$STATUS($P(FMSDOCNO,"^",2)) ; FMS CR doc status
  1. . . ; PRCA*4.5*332 End modified code block
  1. . . S DATA=DATA_"^"_ZZ ; FMS CR doc status
  1. . . S DATA=DATA_"^"_RCRECTDA ; IEN of file 344
  1. . . ;
  1. . . ; Index ^TMP global by user selected sort order
  1. . . I RCSORT="D" S RCIX=RCDPDATA(344,RCRECTDA,.03,"I")
  1. . . I RCSORT="F" S RCIX=FMSTATUS
  1. . . I RCSORT="T" S RCIX=PTYPE
  1. . . S ^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA)=DATA
  1. ;
  1. S Y=$P(DATESTRT,".") S DATEDIS1=$$FMTE^XLFDT(Y,"2DZ")
  1. S Y=$P(DATEEND,".") S DATEDIS2=$$FMTE^XLFDT(Y,"2DZ")
  1. D NOW^%DTC S Y=% D DD^%DT S NOW=Y
  1. S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)=""
  1. S SCREEN=0 I '$D(ZTQUEUED),'$G(RCLSTMGR),IO=IO(0),$E(IOST)="C" S SCREEN=1
  1. D HDR ; Compile header in to ^TMP for use in report or ListMan
  1. U IO D:'$G(RCLSTMGR) H
  1. S CNT=0
  1. S RCIX=0 F S RCIX=$O(^TMP($J,"RCDPRLIS","SORT",RCIX)) Q:RCIX=""!($G(RCRJFLAG)) D
  1. . S RCRECTDA=0 F S RCRECTDA=$O(^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA)) Q:'RCRECTDA!($G(RCRJFLAG)) D
  1. . . S DATA=^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA)
  1. . . S DATE=$P(DATA,"^",2)
  1. . . S CNT=CNT+1
  1. . . S XX=""
  1. . . I RCLSTMGR S XX=" "_$E(CNT_SPACE,1,4)_" " ; line number (for listman)
  1. . . S XX=XX_$$FMTE^XLFDT(DATE,"2ZD")_" " ; date opened
  1. . . S XX=XX_$E($P(DATA,"^",1)_SPACE,1,12)_" " ; receipt number
  1. . . S XX=XX_$E($P(DATA,"^",3)_SPACE,1,$S(RCLSTMGR:5,1:6))_" " ; payment type PRCA*4.5*332
  1. . . S XX=XX_$E($P(DATA,"^",4)_SPACE,1,7)_" " ; user initials PRCA*4.5*332
  1. . . S XX=XX_$J($P(DATA,"^",5),5) ; payment count
  1. . . S XX=XX_$J($P(DATA,"^",6),$S(RCLSTMGR:11,1:13),2)_" " ; payment amount
  1. . . S XX=XX_$E($P(DATA,"^",7)_SPACE,1) ; pre lockbox
  1. . . S XX=XX_$E($P(DATA,"^",8)_SPACE,1,16)_" " ; fms cr document
  1. . . S XX=XX_$E($P(DATA,"^",9),1,6) ; fms cr doc status
  1. . . ;
  1. . . ; Write line or put it to global
  1. . . I '$G(RCLSTMGR) D ;
  1. . . . W !,XX
  1. . . E D ;
  1. . . . S ^TMP($J,"RCDPRLIS",CNT)=XX
  1. . . . S ^TMP($J,"RCDPRLIS","IDX",CNT)=$P(DATA,"^",10) ; Cross reference line# vs file 344 DA
  1. . . ;
  1. . . ; set pre lockbox flag to 1 to show note at end of report
  1. . . I $P(DATA,"^",7)="*" S RCDPFPRE=1
  1. . . ;
  1. . . I '$G(RCLSTMGR),$Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
  1. ;
  1. I $G(RCLSTMGR) Q ; PRCA*4.5*321 - Totals don't have a place in a protocol list with actions
  1. ;
  1. I $G(RCRJFLAG) D CLEAN Q
  1. I $G(RCDPFPRE) W !?54,"*CR tied to deposit"
  1. W !?33,"------ -----------"
  1. W !?33,$J($P($G(TOTALS),"^"),6),$J($P($G(TOTALS),"^",2),13,2)
  1. ;
  1. ; show totals by type of payment
  1. W !!,"TOTALS BY TYPE OF PAYMENT"
  1. W !,"-------------------------"
  1. S TYPE="" F S TYPE=$O(TOTALS(TYPE)) Q:TYPE=""!($G(RCRJFLAG)) D
  1. . W !,TYPE,?33,$J($P(TOTALS(TYPE),"^"),6),$J($P(TOTALS(TYPE),"^",2),13,2)
  1. . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
  1. ;
  1. W !!,"*** END OF REPORT ***",!
  1. ;
  1. I $G(RCRJFLAG) D CLEAN Q
  1. I SCREEN U IO(0) R !,"Press RETURN to continue:",%:DTIME
  1. ;
  1. I '$G(RCLSTMGR) D CLEAN
  1. Q
  1. ;
  1. RCPTTL(RCRECTDA) ; Returns the Total Amount of all of the Receipt Transactions
  1. ; PRCA*4.5*349 - Added Method
  1. ; Input: RCRECTDA - IEN of the Receipt (#344)
  1. ; Returns: Total Amount of all of the Receipt Transactions
  1. N TOTAL,X
  1. S X=0,TOTAL=0
  1. F D Q:'X
  1. . S X=$O(^RCY(344,+$G(RCRECTDA),1,X)) Q:'X
  1. . S TOTAL=TOTAL+$P($G(^(X,0)),"^",4)
  1. Q TOTAL
  1. ;
  1. TYPE(AREVENT) ; Returns an abbreviated type of the AR EVENT - PRCA*4.5*332 Subroutine added
  1. ; Input: AREVENT - External AR Event Type (file 344, field .04)
  1. ; Returns: 6 character (max) event type abbreviation
  1. I AREVENT="EDI LOCKBOX" Q "EDI"
  1. I AREVENT="CASH PAYMENT" Q "CASH"
  1. I AREVENT="CHECK/MO PAYMENT" Q "CHECK"
  1. I AREVENT="LOCKBOX" Q "LOCKBX"
  1. Q $E(AREVENT,1,6)
  1. ;
  1. STATUS(STATUS) ; Returns an abbreviated status of the FMS Doc Status - PRCA*4.5*332 Subroutine added
  1. ; Input: STATUS - 2nd word of the FMS Doc Status
  1. ; Returns: 9 character (max) status
  1. S STATUS=$P(STATUS," ",1)
  1. I STATUS="TRANSMITTED" Q "XMIT"
  1. I STATUS="ACCEPTED" Q "ACCEPT"
  1. I STATUS="REJECTED" Q "REJECT"
  1. I STATUS="NOT" Q "NOTENT"
  1. I STATUS="ON" Q "ONLINE"
  1. Q STATUS
  1. ;
  1. CLEAN ; Clean up ^TMP arrays
  1. D ^%ZISC
  1. K ^TMP($J,"RCDPRLIS")
  1. Q
  1. ;
  1. SORTSEL() ; Select sort order for report, by Date Opened, FMS Status or Payment Type
  1. ; Input: None
  1. ; Return: Sort Type D - Date, F - FMS Status, T - Payment Type
  1. N DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT,RCREP
  1. W !
  1. S DIR(0)="SOA^D:Date;F:FMS Status;T:Type of payment"
  1. S DIR("A")="Sort By (D)ATE OPENED, (F)MS STATUS OR (T)YPE OF PAYMENT: "
  1. S DIR("B")="D"
  1. S DIR("?",1)="Select the order you wish the receipts to appear in on the report."
  1. S DIR("?",2)=" "
  1. S DIR("?",3)=" D - Sort by the date the receipt was opened"
  1. S DIR("?",4)=" S - Sort by the FMS Status"
  1. S DIR("?")=" T - Sort by the Payment Type"
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") S RETURN=-1
  1. E S RETURN=Y
  1. Q RETURN
  1. ;
  1. SELFILTF(RETURN) ; Ask if user want to filter by FMS status. If yes get list of status.
  1. ; Input: None
  1. ; Output: RETURN, passed by reference
  1. ; RETURN - 1=Filter by FMS Status, 0=Don't
  1. ; RETURN(STATUS) - array of FMS Status to include in the report
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,J,QUIT,RCODES,RCOUT,X,Y
  1. K RETURN
  1. S RETURN=0
  1. ;
  1. W !
  1. S DIR(0)="YA"
  1. S DIR("A")="Filter by FMS Status? (Y/N): "
  1. S DIR("B")="NO"
  1. S DIR("?",1)="Enter 'Y' or 'Yes' to only show receipts with selected FMS Status"
  1. S DIR("?",2)="Enter 'N' or 'No' if you wish to show receipts including all FMS Status"
  1. S DIR("?")="If you select yes, you will be prompted for the FMS Status' you wish to include"
  1. D ^DIR
  1. I $D(DIRUT) S RETURN=-1 Q
  1. I Y=0 Q
  1. S RETURN=1
  1. ;
  1. ; Prompt for status' to be included. Multi-select
  1. W !
  1. D FIELD^DID(2100.1,3,"","POINTER","RCOUT")
  1. S RCODES=RCOUT("POINTER")
  1. ; Add pseudo codes to list for "NOT ENTERED" and "ON LINE ENTRY" returned by FMSSTAT^RCDPUREC
  1. I $E(RCODES,$L(RCODES))'=";" S RCODES=RCODES_";"
  1. S RCODES=RCODES_"O:ON LINE ENTRY;N:NOT ENTERED"
  1. K DIR
  1. S DIR(0)="SOA^"_RCODES
  1. S DIR("A")="Select an FMS Status to include in the report: "
  1. K DIR("?")
  1. S DIR("?",1)="Select an FMS Status to show in the report."
  1. S DIR("?",2)="You will be prompted multiple times, until you hit ENTER"
  1. S DIR("?")="without making a selection."
  1. S QUIT=0
  1. F D I QUIT Q
  1. . W !
  1. . D ^DIR
  1. . I $D(DTOUT)!$D(DUOUT) K RETURN S RETURN=-1,QUIT=1 Q
  1. . I Y="" S QUIT=1 Q
  1. . S RETURN(Y(0))=""
  1. . ; Rebuid DIR(0) to only include codes not yet selected
  1. . S DIR(0)=$$BLDS(RCODES,.RETURN)
  1. . I $P(DIR(0),"^",2)="" S QUIT=1 ; All status selected so stop prompting.
  1. I RETURN=-1 Q
  1. ; If no FMS Status' were selected, don't filter by it.
  1. I $O(RETURN(""))="" D ;
  1. . S RETURN=0
  1. . W !!,"No FMS Status' were selected. All FMS Status' will be shown",!
  1. Q
  1. ;
  1. SELFILTT(RETURN) ; Ask if user want to filter by Payment Type. If yes get list of types.
  1. ; Input: None
  1. ; Output: RETURN, passed by reference
  1. ; RETURN - 1=Filter by FMS Status, 0=Don't
  1. ; RETURN(STATUS) - array of FMS Status to include in the report
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCODES,RCIEN,RCNAME,QUIT,X,Y
  1. K RETURN
  1. S RETURN=0
  1. ;
  1. W !
  1. S DIR(0)="YA"
  1. S DIR("A")="Filter by Payment Type? (Y/N): "
  1. S DIR("B")="NO"
  1. S DIR("?",1)="Enter 'Y' or 'Yes' to only show receipts with selected Payment Types"
  1. S DIR("?",2)="Enter 'N' or 'No' if you wish to show receipts including all Payment Types"
  1. S DIR("?")="If you select yes, you will be prompted for the Payment Types you wish to include"
  1. D ^DIR
  1. I $D(DIRUT) S RETURN=-1 Q
  1. I Y=0 Q
  1. S RETURN=1
  1. ;
  1. ; Prompt for types to be included. Multi-select
  1. W !
  1. K DIR
  1. ; Present payment types as a set of codes to streamline user interface/selection/help
  1. S (RCODES,RCNAME)=""
  1. F S RCNAME=$O(^RC(341.1,"B",RCNAME)) Q:RCNAME="" D ;
  1. . S RCIEN=0 F S RCIEN=$O(^RC(341.1,"B",RCNAME,RCIEN)) Q:'RCIEN D ;
  1. . . I $$GET1^DIQ(341.1,RCIEN_",",.06,"I")=1 D ;
  1. . . . S RCODES=RCODES_":"_$$GET1^DIQ(341.1,RCIEN_",",.01,"E")_";"
  1. S DIR(0)="SOA^"_RCODES
  1. S DIR("A")="Select a Payment Type to include in the report: "
  1. K DIR("?")
  1. S DIR("?",1)="Select an Payment Type to include in the report."
  1. S DIR("?",2)="You will be prompted multiple times, until you hit ENTER"
  1. S DIR("?")="without making a selection."
  1. S QUIT=0
  1. F D I QUIT Q
  1. . W !
  1. . D ^DIR
  1. . I $D(DTOUT)!$D(DUOUT) K RETURN S RETURN=-1,QUIT=1 Q
  1. . I $G(Y(0))="" S QUIT=1 Q
  1. . S RETURN(Y(0))=""
  1. . ; Rebuid DIR(0) to only include codes not yet selected
  1. . S DIR(0)=$$BLDS(RCODES,.RETURN)
  1. . I $P(DIR(0),"^",2)="" S QUIT=1 ; All status selected so stop prompting.
  1. ;
  1. I RETURN=-1 Q
  1. ; If no payment types were selected, don't filter by it.
  1. I $O(RETURN(""))="" D ;
  1. . S RETURN=0
  1. . W !!,"No Payment Types were selected. Filter will not be used",!
  1. Q
  1. ;
  1. BLDS(CODES,PICKED) ; Build DIR(0) string taking into account codes already picked.
  1. ; Input: CODES - Set of codes string in fileman format e.g. A:Apple;B:Ball;
  1. ; PICKED - Array of values already picked, subscripted by external value e.g. PICKED("Apple")=""
  1. ; Return: RETURN in DIR(0) format. Set of codes that only includes ones not picked.
  1. ; e.g "SAO^B:Ball"
  1. ;
  1. N RETURN
  1. S RETURN="SOA^"
  1. F J=1:1:$L(CODES,";") D ;
  1. . S X=$P($P(CODES,";",J),":",2)
  1. . I X'="",'$D(PICKED(X)) S RETURN=RETURN_$P(CODES,";",J)_";"
  1. Q RETURN
  1. ;
  1. HDR ; Compile header into ^TMP for use in ListMan or report
  1. ; Input: None
  1. ; Output: Header information in ^TMP($J,"RCDPRLIS","HDR",n) for us in report or ListMan formats
  1. N K,XX
  1. S ^TMP($J,"RCDPRLIS","HDR",1)="LIST OF RECEIPTS REPORT"
  1. S XX=" DATE RANGE : "_DATEDIS1_" TO "_DATEDIS2_" "
  1. S XX=XX_"SORT ORDER: "_$S(RCSORT="D":"DATE OPENED",RCSORT="F":"FMS STATUS",1:"PAYMENT TYPE")
  1. S ^TMP($J,"RCDPRLIS","HDR",2)=XX
  1. ;
  1. I 'RCFILTF D ;
  1. . S XX="ALL"
  1. E D ;
  1. . S XX=""
  1. . S K="" F S K=$O(RCFILTF(K)) Q:K="" S:XX'="" XX=XX_"; " S XX=XX_K
  1. S ^TMP($J,"RCDPRLIS","HDR",3)=" FMS STATUS : "_$S($L(XX)>63:"SELECTED",1:XX)
  1. ;
  1. I 'RCFILTT D ;
  1. . S XX="ALL"
  1. E D ;
  1. . S XX=""
  1. . S K="" F S K=$O(RCFILTT(K)) Q:K="" S:XX'="" XX=XX_"; " S XX=XX_K
  1. S ^TMP($J,"RCDPRLIS","HDR",4)=" PAYMENT TYPES: "_$S($L(XX)>63:"SELECTED",1:XX)
  1. ; PRCA*4.5*332
  1. S ^TMP($J,"RCDPRLIS","HDR",5)="DATE RECEIPT TYPE USER COUNT AMOUNT FMS CR DOC STATUS"
  1. W !,RCRJLINE
  1. Q
  1. ;
  1. H ; header
  1. N %
  1. S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
  1. W $C(13),^TMP($J,"RCDPRLIS","HDR",1),?(80-$L(%)),%
  1. W !,^TMP($J,"RCDPRLIS","HDR",2)
  1. W !,^TMP($J,"RCDPRLIS","HDR",3)
  1. W !,^TMP($J,"RCDPRLIS","HDR",4)
  1. W !,^TMP($J,"RCDPRLIS","HDR",5)
  1. W !,RCRJLINE
  1. Q