- RCDPRLIS ;WISC/RFJ - list of receipts report ;1 Jun 99
- ;;4.5;Accounts Receivable;**114,304,321,332,349**;Mar 20, 1995;Build 44
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- N %ZIS,DATEEND,DATESTRT,POP,RCFILTF,RCFILTT,RCLSTMGR,RCSORT
- N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
- W !
- D DATESEL^RCRJRTRA("RECEIPT Opened")
- I '$G(DATESTRT)!('$G(DATEEND)) Q
- ;
- ; Prompt for sort order PRCA*4.5*321
- S RCSORT=$$SORTSEL()
- I RCSORT=-1 Q
- ;
- ; Prompt for filter by FMS Status PRCA*4.5*321
- D SELFILTF(.RCFILTF)
- I RCFILTF=-1 Q
- ;
- ; Prompt for filter by Payment Type PRCA*4.5*321
- D SELFILTT(.RCFILTT)
- I RCFILTT=-1 Q
- ;
- ; Ask for ListMan display, exit if timeout or '^'
- W !
- S RCLSTMGR=$$ASKLM^RCDPEARL() I RCLSTMGR<0 Q
- ;
- ; Send report to Listman if requested
- I RCLSTMGR D D CLEAN Q
- . D DQ
- . D EN^RCDPRL
- ;
- ; select device
- W ! S %ZIS="Q" D ^%ZIS I POP Q
- I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
- . S ZTDESC="List of Receipts",ZTRTN="DQ^RCDPRLIS"
- . S ZTSAVE("DATE*")="",ZTSAVE("RC*")="",ZTSAVE("ZTREQ")="@"
- W !!,"<*> please wait <*>"
- D DQ
- Q
- ;
- DQ ; queued report starts here
- ; PRCA*4.5*321 Extensive changes to this subroutine for filter/sort/ListMan
- N %,%I,CNT,DATA,DATE,DATEDIS1,DATEDIS2,FMSDOCNO,FMSTATUS,NOW,PAGE,PTYPE,RCDK,RCDPDATA
- ;
- ; PRCA*4.5*349 - Added RCTTL
- N RCDPFPRE,RCIX,RCRECTDA,RCRJFLAG,RCRJLINE,RCTTL,RCUSER,SCREEN,SPACE,TOTALS,TYPE,X,XX,Y,ZZ ; PRCA*4.5*332
- K ^TMP($J,"RCDPRLIS")
- S SPACE=$J("",80)
- S RCDK=$$FMADD^XLFDT(DATESTRT,-1)_".24" ; Initialize start date for first $ORDER
- S DATEEND=DATEEND_".24" ; Receipt date opened can include time, so compare with midnight on the end date.
- F S RCDK=$O(^RCY(344,"AO",RCDK)) Q:(RCDK=""!(RCDK>DATEEND)) D ;
- . S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AO",RCDK,RCRECTDA)) Q:'RCRECTDA D
- . . K RCDPDATA
- . . D DIQ344^RCDPRPLM(RCRECTDA,".01:200")
- . . S FMSDOCNO=$$FMSSTAT^RCDPUREC(RCRECTDA) ; get FMS Document^Status^Pre lockbox patch
- . . S FMSTATUS=$P(FMSDOCNO,"^",2) ; Apply filter by FMS Status
- . . I RCFILTF,FMSTATUS'="",'$D(RCFILTF(FMSTATUS)) Q ; Status not included
- . . S PTYPE=RCDPDATA(344,RCRECTDA,.04,"E") ; Apply filter by Payment Type
- . . I RCFILTT,PTYPE'="",'$D(RCFILTT(PTYPE)) Q ; Status not included
- . . S RCTTL=$$RCPTTL(RCRECTDA) ; PRCA*4.5*349 - Total of receipt
- . . ;
- . . ; Compute totals by type
- . . I RCDPDATA(344,RCRECTDA,.04,"E")="" S RCDPDATA(344,RCRECTDA,.04,"E")="UNKNOWN"
- . . S $P(TOTALS(PTYPE),"^",1)=$P($G(TOTALS(PTYPE)),"^",1)+RCDPDATA(344,RCRECTDA,101,"E")
- . . ;
- . . ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
- . . S $P(TOTALS(PTYPE),"^",2)=$P($G(TOTALS(PTYPE)),"^",2)+RCTTL
- . . S $P(TOTALS,"^",1)=$P($G(TOTALS),"^",1)+RCDPDATA(344,RCRECTDA,101,"E")
- . . ;
- . . ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
- . . S $P(TOTALS,"^",2)=$P($G(TOTALS),"^",2)+RCTTL
- . . ;
- . . I RCDPDATA(344,RCRECTDA,.02,"I")=.5 D ; Opened by
- . . . S RCUSER="ar"
- . . ; PRCA*4.5*332 Begin modified code block
- . . E D ;
- . . . S RCUSER=RCDPDATA(344,RCRECTDA,.02,"E")
- . . . I RCUSER'="" D
- . . . . S RCUSER=$E($P(RCUSER,",",1),1,5)_","_$E($P(RCUSER,",",2),1)
- . . ;
- . . S DATA=RCDPDATA(344,RCRECTDA,.01,"E") ; Receipt number
- . . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,.03,"I") ; Date opened
- . . S ZZ=$$TYPE(RCDPDATA(344,RCRECTDA,.04,"E")) ; Payment type
- . . S DATA=DATA_"^"_ZZ ; Payment type
- . . S DATA=DATA_"^"_RCUSER ; User initials
- . . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,101,"E") ; Payment count
- . . ;
- . . ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
- . . S DATA=DATA_"^"_RCTTL ; Payment amount
- . . S DATA=DATA_"^"_$S($P(FMSDOCNO,"^",3):"*",1:" ") ; Pre lockbox
- . . S DATA=DATA_"^"_$P(FMSDOCNO,"^") ; FMS CR document
- . . S ZZ=$$STATUS($P(FMSDOCNO,"^",2)) ; FMS CR doc status
- . . ; PRCA*4.5*332 End modified code block
- . . S DATA=DATA_"^"_ZZ ; FMS CR doc status
- . . S DATA=DATA_"^"_RCRECTDA ; IEN of file 344
- . . ;
- . . ; Index ^TMP global by user selected sort order
- . . I RCSORT="D" S RCIX=RCDPDATA(344,RCRECTDA,.03,"I")
- . . I RCSORT="F" S RCIX=FMSTATUS
- . . I RCSORT="T" S RCIX=PTYPE
- . . S ^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA)=DATA
- ;
- S Y=$P(DATESTRT,".") S DATEDIS1=$$FMTE^XLFDT(Y,"2DZ")
- S Y=$P(DATEEND,".") S DATEDIS2=$$FMTE^XLFDT(Y,"2DZ")
- D NOW^%DTC S Y=% D DD^%DT S NOW=Y
- S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)=""
- S SCREEN=0 I '$D(ZTQUEUED),'$G(RCLSTMGR),IO=IO(0),$E(IOST)="C" S SCREEN=1
- D HDR ; Compile header in to ^TMP for use in report or ListMan
- U IO D:'$G(RCLSTMGR) H
- S CNT=0
- S RCIX=0 F S RCIX=$O(^TMP($J,"RCDPRLIS","SORT",RCIX)) Q:RCIX=""!($G(RCRJFLAG)) D
- . S RCRECTDA=0 F S RCRECTDA=$O(^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA)) Q:'RCRECTDA!($G(RCRJFLAG)) D
- . . S DATA=^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA)
- . . S DATE=$P(DATA,"^",2)
- . . S CNT=CNT+1
- . . S XX=""
- . . I RCLSTMGR S XX=" "_$E(CNT_SPACE,1,4)_" " ; line number (for listman)
- . . S XX=XX_$$FMTE^XLFDT(DATE,"2ZD")_" " ; date opened
- . . S XX=XX_$E($P(DATA,"^",1)_SPACE,1,12)_" " ; receipt number
- . . S XX=XX_$E($P(DATA,"^",3)_SPACE,1,$S(RCLSTMGR:5,1:6))_" " ; payment type PRCA*4.5*332
- . . S XX=XX_$E($P(DATA,"^",4)_SPACE,1,7)_" " ; user initials PRCA*4.5*332
- . . S XX=XX_$J($P(DATA,"^",5),5) ; payment count
- . . S XX=XX_$J($P(DATA,"^",6),$S(RCLSTMGR:11,1:13),2)_" " ; payment amount
- . . S XX=XX_$E($P(DATA,"^",7)_SPACE,1) ; pre lockbox
- . . S XX=XX_$E($P(DATA,"^",8)_SPACE,1,16)_" " ; fms cr document
- . . S XX=XX_$E($P(DATA,"^",9),1,6) ; fms cr doc status
- . . ;
- . . ; Write line or put it to global
- . . I '$G(RCLSTMGR) D ;
- . . . W !,XX
- . . E D ;
- . . . S ^TMP($J,"RCDPRLIS",CNT)=XX
- . . . S ^TMP($J,"RCDPRLIS","IDX",CNT)=$P(DATA,"^",10) ; Cross reference line# vs file 344 DA
- . . ;
- . . ; set pre lockbox flag to 1 to show note at end of report
- . . I $P(DATA,"^",7)="*" S RCDPFPRE=1
- . . ;
- . . I '$G(RCLSTMGR),$Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
- ;
- I $G(RCLSTMGR) Q ; PRCA*4.5*321 - Totals don't have a place in a protocol list with actions
- ;
- I $G(RCRJFLAG) D CLEAN Q
- I $G(RCDPFPRE) W !?54,"*CR tied to deposit"
- W !?33,"------ -----------"
- W !?33,$J($P($G(TOTALS),"^"),6),$J($P($G(TOTALS),"^",2),13,2)
- ;
- ; show totals by type of payment
- W !!,"TOTALS BY TYPE OF PAYMENT"
- W !,"-------------------------"
- S TYPE="" F S TYPE=$O(TOTALS(TYPE)) Q:TYPE=""!($G(RCRJFLAG)) D
- . W !,TYPE,?33,$J($P(TOTALS(TYPE),"^"),6),$J($P(TOTALS(TYPE),"^",2),13,2)
- . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
- ;
- W !!,"*** END OF REPORT ***",!
- ;
- I $G(RCRJFLAG) D CLEAN Q
- I SCREEN U IO(0) R !,"Press RETURN to continue:",%:DTIME
- ;
- I '$G(RCLSTMGR) D CLEAN
- Q
- ;
- RCPTTL(RCRECTDA) ; Returns the Total Amount of all of the Receipt Transactions
- ; PRCA*4.5*349 - Added Method
- ; Input: RCRECTDA - IEN of the Receipt (#344)
- ; Returns: Total Amount of all of the Receipt Transactions
- N TOTAL,X
- S X=0,TOTAL=0
- F D Q:'X
- . S X=$O(^RCY(344,+$G(RCRECTDA),1,X)) Q:'X
- . S TOTAL=TOTAL+$P($G(^(X,0)),"^",4)
- Q TOTAL
- ;
- TYPE(AREVENT) ; Returns an abbreviated type of the AR EVENT - PRCA*4.5*332 Subroutine added
- ; Input: AREVENT - External AR Event Type (file 344, field .04)
- ; Returns: 6 character (max) event type abbreviation
- I AREVENT="EDI LOCKBOX" Q "EDI"
- I AREVENT="CASH PAYMENT" Q "CASH"
- I AREVENT="CHECK/MO PAYMENT" Q "CHECK"
- I AREVENT="LOCKBOX" Q "LOCKBX"
- Q $E(AREVENT,1,6)
- ;
- STATUS(STATUS) ; Returns an abbreviated status of the FMS Doc Status - PRCA*4.5*332 Subroutine added
- ; Input: STATUS - 2nd word of the FMS Doc Status
- ; Returns: 9 character (max) status
- S STATUS=$P(STATUS," ",1)
- I STATUS="TRANSMITTED" Q "XMIT"
- I STATUS="ACCEPTED" Q "ACCEPT"
- I STATUS="REJECTED" Q "REJECT"
- I STATUS="NOT" Q "NOTENT"
- I STATUS="ON" Q "ONLINE"
- Q STATUS
- ;
- CLEAN ; Clean up ^TMP arrays
- D ^%ZISC
- K ^TMP($J,"RCDPRLIS")
- Q
- ;
- SORTSEL() ; Select sort order for report, by Date Opened, FMS Status or Payment Type
- ; Input: None
- ; Return: Sort Type D - Date, F - FMS Status, T - Payment Type
- N DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT,RCREP
- W !
- S DIR(0)="SOA^D:Date;F:FMS Status;T:Type of payment"
- S DIR("A")="Sort By (D)ATE OPENED, (F)MS STATUS OR (T)YPE OF PAYMENT: "
- S DIR("B")="D"
- S DIR("?",1)="Select the order you wish the receipts to appear in on the report."
- S DIR("?",2)=" "
- S DIR("?",3)=" D - Sort by the date the receipt was opened"
- S DIR("?",4)=" S - Sort by the FMS Status"
- S DIR("?")=" T - Sort by the Payment Type"
- D ^DIR
- I $D(DTOUT)!$D(DUOUT)!(Y="") S RETURN=-1
- E S RETURN=Y
- Q RETURN
- ;
- SELFILTF(RETURN) ; Ask if user want to filter by FMS status. If yes get list of status.
- ; Input: None
- ; Output: RETURN, passed by reference
- ; RETURN - 1=Filter by FMS Status, 0=Don't
- ; RETURN(STATUS) - array of FMS Status to include in the report
- ;
- N DIR,DIROUT,DIRUT,DTOUT,DUOUT,J,QUIT,RCODES,RCOUT,X,Y
- K RETURN
- S RETURN=0
- ;
- W !
- S DIR(0)="YA"
- S DIR("A")="Filter by FMS Status? (Y/N): "
- S DIR("B")="NO"
- S DIR("?",1)="Enter 'Y' or 'Yes' to only show receipts with selected FMS Status"
- S DIR("?",2)="Enter 'N' or 'No' if you wish to show receipts including all FMS Status"
- S DIR("?")="If you select yes, you will be prompted for the FMS Status' you wish to include"
- D ^DIR
- I $D(DIRUT) S RETURN=-1 Q
- I Y=0 Q
- S RETURN=1
- ;
- ; Prompt for status' to be included. Multi-select
- W !
- D FIELD^DID(2100.1,3,"","POINTER","RCOUT")
- S RCODES=RCOUT("POINTER")
- ; Add pseudo codes to list for "NOT ENTERED" and "ON LINE ENTRY" returned by FMSSTAT^RCDPUREC
- I $E(RCODES,$L(RCODES))'=";" S RCODES=RCODES_";"
- S RCODES=RCODES_"O:ON LINE ENTRY;N:NOT ENTERED"
- K DIR
- S DIR(0)="SOA^"_RCODES
- S DIR("A")="Select an FMS Status to include in the report: "
- K DIR("?")
- S DIR("?",1)="Select an FMS Status to show in the report."
- S DIR("?",2)="You will be prompted multiple times, until you hit ENTER"
- S DIR("?")="without making a selection."
- S QUIT=0
- F D I QUIT Q
- . W !
- . D ^DIR
- . I $D(DTOUT)!$D(DUOUT) K RETURN S RETURN=-1,QUIT=1 Q
- . I Y="" S QUIT=1 Q
- . S RETURN(Y(0))=""
- . ; Rebuid DIR(0) to only include codes not yet selected
- . S DIR(0)=$$BLDS(RCODES,.RETURN)
- . I $P(DIR(0),"^",2)="" S QUIT=1 ; All status selected so stop prompting.
- I RETURN=-1 Q
- ; If no FMS Status' were selected, don't filter by it.
- I $O(RETURN(""))="" D ;
- . S RETURN=0
- . W !!,"No FMS Status' were selected. All FMS Status' will be shown",!
- Q
- ;
- SELFILTT(RETURN) ; Ask if user want to filter by Payment Type. If yes get list of types.
- ; Input: None
- ; Output: RETURN, passed by reference
- ; RETURN - 1=Filter by FMS Status, 0=Don't
- ; RETURN(STATUS) - array of FMS Status to include in the report
- ;
- N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCODES,RCIEN,RCNAME,QUIT,X,Y
- K RETURN
- S RETURN=0
- ;
- W !
- S DIR(0)="YA"
- S DIR("A")="Filter by Payment Type? (Y/N): "
- S DIR("B")="NO"
- S DIR("?",1)="Enter 'Y' or 'Yes' to only show receipts with selected Payment Types"
- S DIR("?",2)="Enter 'N' or 'No' if you wish to show receipts including all Payment Types"
- S DIR("?")="If you select yes, you will be prompted for the Payment Types you wish to include"
- D ^DIR
- I $D(DIRUT) S RETURN=-1 Q
- I Y=0 Q
- S RETURN=1
- ;
- ; Prompt for types to be included. Multi-select
- W !
- K DIR
- ; Present payment types as a set of codes to streamline user interface/selection/help
- S (RCODES,RCNAME)=""
- F S RCNAME=$O(^RC(341.1,"B",RCNAME)) Q:RCNAME="" D ;
- . S RCIEN=0 F S RCIEN=$O(^RC(341.1,"B",RCNAME,RCIEN)) Q:'RCIEN D ;
- . . I $$GET1^DIQ(341.1,RCIEN_",",.06,"I")=1 D ;
- . . . S RCODES=RCODES_":"_$$GET1^DIQ(341.1,RCIEN_",",.01,"E")_";"
- S DIR(0)="SOA^"_RCODES
- S DIR("A")="Select a Payment Type to include in the report: "
- K DIR("?")
- S DIR("?",1)="Select an Payment Type to include in the report."
- S DIR("?",2)="You will be prompted multiple times, until you hit ENTER"
- S DIR("?")="without making a selection."
- S QUIT=0
- F D I QUIT Q
- . W !
- . D ^DIR
- . I $D(DTOUT)!$D(DUOUT) K RETURN S RETURN=-1,QUIT=1 Q
- . I $G(Y(0))="" S QUIT=1 Q
- . S RETURN(Y(0))=""
- . ; Rebuid DIR(0) to only include codes not yet selected
- . S DIR(0)=$$BLDS(RCODES,.RETURN)
- . I $P(DIR(0),"^",2)="" S QUIT=1 ; All status selected so stop prompting.
- ;
- I RETURN=-1 Q
- ; If no payment types were selected, don't filter by it.
- I $O(RETURN(""))="" D ;
- . S RETURN=0
- . W !!,"No Payment Types were selected. Filter will not be used",!
- Q
- ;
- BLDS(CODES,PICKED) ; Build DIR(0) string taking into account codes already picked.
- ; Input: CODES - Set of codes string in fileman format e.g. A:Apple;B:Ball;
- ; PICKED - Array of values already picked, subscripted by external value e.g. PICKED("Apple")=""
- ; Return: RETURN in DIR(0) format. Set of codes that only includes ones not picked.
- ; e.g "SAO^B:Ball"
- ;
- N RETURN
- S RETURN="SOA^"
- F J=1:1:$L(CODES,";") D ;
- . S X=$P($P(CODES,";",J),":",2)
- . I X'="",'$D(PICKED(X)) S RETURN=RETURN_$P(CODES,";",J)_";"
- Q RETURN
- ;
- HDR ; Compile header into ^TMP for use in ListMan or report
- ; Input: None
- ; Output: Header information in ^TMP($J,"RCDPRLIS","HDR",n) for us in report or ListMan formats
- N K,XX
- S ^TMP($J,"RCDPRLIS","HDR",1)="LIST OF RECEIPTS REPORT"
- S XX=" DATE RANGE : "_DATEDIS1_" TO "_DATEDIS2_" "
- S XX=XX_"SORT ORDER: "_$S(RCSORT="D":"DATE OPENED",RCSORT="F":"FMS STATUS",1:"PAYMENT TYPE")
- S ^TMP($J,"RCDPRLIS","HDR",2)=XX
- ;
- I 'RCFILTF D ;
- . S XX="ALL"
- E D ;
- . S XX=""
- . S K="" F S K=$O(RCFILTF(K)) Q:K="" S:XX'="" XX=XX_"; " S XX=XX_K
- S ^TMP($J,"RCDPRLIS","HDR",3)=" FMS STATUS : "_$S($L(XX)>63:"SELECTED",1:XX)
- ;
- I 'RCFILTT D ;
- . S XX="ALL"
- E D ;
- . S XX=""
- . S K="" F S K=$O(RCFILTT(K)) Q:K="" S:XX'="" XX=XX_"; " S XX=XX_K
- S ^TMP($J,"RCDPRLIS","HDR",4)=" PAYMENT TYPES: "_$S($L(XX)>63:"SELECTED",1:XX)
- ; PRCA*4.5*332
- S ^TMP($J,"RCDPRLIS","HDR",5)="DATE RECEIPT TYPE USER COUNT AMOUNT FMS CR DOC STATUS"
- W !,RCRJLINE
- Q
- ;
- H ; header
- N %
- S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W $C(13),^TMP($J,"RCDPRLIS","HDR",1),?(80-$L(%)),%
- W !,^TMP($J,"RCDPRLIS","HDR",2)
- W !,^TMP($J,"RCDPRLIS","HDR",3)
- W !,^TMP($J,"RCDPRLIS","HDR",4)
- W !,^TMP($J,"RCDPRLIS","HDR",5)
- W !,RCRJLINE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRLIS 15068 printed Feb 18, 2025@23:12:38 Page 2
- 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
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 NEW %ZIS,DATEEND,DATESTRT,POP,RCFILTF,RCFILTT,RCLSTMGR,RCSORT
- +5 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
- +6 WRITE !
- +7 DO DATESEL^RCRJRTRA("RECEIPT Opened")
- +8 IF '$GET(DATESTRT)!('$GET(DATEEND))
- QUIT
- +9 ;
- +10 ; Prompt for sort order PRCA*4.5*321
- +11 SET RCSORT=$$SORTSEL()
- +12 IF RCSORT=-1
- QUIT
- +13 ;
- +14 ; Prompt for filter by FMS Status PRCA*4.5*321
- +15 DO SELFILTF(.RCFILTF)
- +16 IF RCFILTF=-1
- QUIT
- +17 ;
- +18 ; Prompt for filter by Payment Type PRCA*4.5*321
- +19 DO SELFILTT(.RCFILTT)
- +20 IF RCFILTT=-1
- QUIT
- +21 ;
- +22 ; Ask for ListMan display, exit if timeout or '^'
- +23 WRITE !
- +24 SET RCLSTMGR=$$ASKLM^RCDPEARL()
- IF RCLSTMGR<0
- QUIT
- +25 ;
- +26 ; Send report to Listman if requested
- +27 IF RCLSTMGR
- Begin DoDot:1
- +28 DO DQ
- +29 DO EN^RCDPRL
- End DoDot:1
- DO CLEAN
- QUIT
- +30 ;
- +31 ; select device
- +32 WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- QUIT
- +33 IF $DATA(IO("Q"))
- Begin DoDot:1
- +34 SET ZTDESC="List of Receipts"
- SET ZTRTN="DQ^RCDPRLIS"
- +35 SET ZTSAVE("DATE*")=""
- SET ZTSAVE("RC*")=""
- SET ZTSAVE("ZTREQ")="@"
- End DoDot:1
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- QUIT
- +36 WRITE !!,"<*> please wait <*>"
- +37 DO DQ
- +38 QUIT
- +39 ;
- DQ ; queued report starts here
- +1 ; PRCA*4.5*321 Extensive changes to this subroutine for filter/sort/ListMan
- +2 NEW %,%I,CNT,DATA,DATE,DATEDIS1,DATEDIS2,FMSDOCNO,FMSTATUS,NOW,PAGE,PTYPE,RCDK,RCDPDATA
- +3 ;
- +4 ; PRCA*4.5*349 - Added RCTTL
- +5 ; PRCA*4.5*332
- NEW RCDPFPRE,RCIX,RCRECTDA,RCRJFLAG,RCRJLINE,RCTTL,RCUSER,SCREEN,SPACE,TOTALS,TYPE,X,XX,Y,ZZ
- +6 KILL ^TMP($JOB,"RCDPRLIS")
- +7 SET SPACE=$JUSTIFY("",80)
- +8 ; Initialize start date for first $ORDER
- SET RCDK=$$FMADD^XLFDT(DATESTRT,-1)_".24"
- +9 ; Receipt date opened can include time, so compare with midnight on the end date.
- SET DATEEND=DATEEND_".24"
- +10 ;
- FOR
- SET RCDK=$ORDER(^RCY(344,"AO",RCDK))
- if (RCDK=""!(RCDK>DATEEND))
- QUIT
- Begin DoDot:1
- +11 SET RCRECTDA=0
- FOR
- SET RCRECTDA=$ORDER(^RCY(344,"AO",RCDK,RCRECTDA))
- if 'RCRECTDA
- QUIT
- Begin DoDot:2
- +12 KILL RCDPDATA
- +13 DO DIQ344^RCDPRPLM(RCRECTDA,".01:200")
- +14 ; get FMS Document^Status^Pre lockbox patch
- SET FMSDOCNO=$$FMSSTAT^RCDPUREC(RCRECTDA)
- +15 ; Apply filter by FMS Status
- SET FMSTATUS=$PIECE(FMSDOCNO,"^",2)
- +16 ; Status not included
- IF RCFILTF
- IF FMSTATUS'=""
- IF '$DATA(RCFILTF(FMSTATUS))
- QUIT
- +17 ; Apply filter by Payment Type
- SET PTYPE=RCDPDATA(344,RCRECTDA,.04,"E")
- +18 ; Status not included
- IF RCFILTT
- IF PTYPE'=""
- IF '$DATA(RCFILTT(PTYPE))
- QUIT
- +19 ; PRCA*4.5*349 - Total of receipt
- SET RCTTL=$$RCPTTL(RCRECTDA)
- +20 ;
- +21 ; Compute totals by type
- +22 IF RCDPDATA(344,RCRECTDA,.04,"E")=""
- SET RCDPDATA(344,RCRECTDA,.04,"E")="UNKNOWN"
- +23 SET $PIECE(TOTALS(PTYPE),"^",1)=$PIECE($GET(TOTALS(PTYPE)),"^",1)+RCDPDATA(344,RCRECTDA,101,"E")
- +24 ;
- +25 ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
- +26 SET $PIECE(TOTALS(PTYPE),"^",2)=$PIECE($GET(TOTALS(PTYPE)),"^",2)+RCTTL
- +27 SET $PIECE(TOTALS,"^",1)=$PIECE($GET(TOTALS),"^",1)+RCDPDATA(344,RCRECTDA,101,"E")
- +28 ;
- +29 ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
- +30 SET $PIECE(TOTALS,"^",2)=$PIECE($GET(TOTALS),"^",2)+RCTTL
- +31 ;
- +32 ; Opened by
- IF RCDPDATA(344,RCRECTDA,.02,"I")=.5
- Begin DoDot:3
- +33 SET RCUSER="ar"
- End DoDot:3
- +34 ; PRCA*4.5*332 Begin modified code block
- +35 ;
- IF '$TEST
- Begin DoDot:3
- +36 SET RCUSER=RCDPDATA(344,RCRECTDA,.02,"E")
- +37 IF RCUSER'=""
- Begin DoDot:4
- +38 SET RCUSER=$EXTRACT($PIECE(RCUSER,",",1),1,5)_","_$EXTRACT($PIECE(RCUSER,",",2),1)
- End DoDot:4
- End DoDot:3
- +39 ;
- +40 ; Receipt number
- SET DATA=RCDPDATA(344,RCRECTDA,.01,"E")
- +41 ; Date opened
- SET DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,.03,"I")
- +42 ; Payment type
- SET ZZ=$$TYPE(RCDPDATA(344,RCRECTDA,.04,"E"))
- +43 ; Payment type
- SET DATA=DATA_"^"_ZZ
- +44 ; User initials
- SET DATA=DATA_"^"_RCUSER
- +45 ; Payment count
- SET DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,101,"E")
- +46 ;
- +47 ; PRCA*4.5*349 - Changed RCDPDATA(344,RCRECTDA,.15,"E") to RCTTL below
- +48 ; Payment amount
- SET DATA=DATA_"^"_RCTTL
- +49 ; Pre lockbox
- SET DATA=DATA_"^"_$SELECT($PIECE(FMSDOCNO,"^",3):"*",1:" ")
- +50 ; FMS CR document
- SET DATA=DATA_"^"_$PIECE(FMSDOCNO,"^")
- +51 ; FMS CR doc status
- SET ZZ=$$STATUS($PIECE(FMSDOCNO,"^",2))
- +52 ; PRCA*4.5*332 End modified code block
- +53 ; FMS CR doc status
- SET DATA=DATA_"^"_ZZ
- +54 ; IEN of file 344
- SET DATA=DATA_"^"_RCRECTDA
- +55 ;
- +56 ; Index ^TMP global by user selected sort order
- +57 IF RCSORT="D"
- SET RCIX=RCDPDATA(344,RCRECTDA,.03,"I")
- +58 IF RCSORT="F"
- SET RCIX=FMSTATUS
- +59 IF RCSORT="T"
- SET RCIX=PTYPE
- +60 SET ^TMP($JOB,"RCDPRLIS","SORT",RCIX,RCRECTDA)=DATA
- End DoDot:2
- End DoDot:1
- +61 ;
- +62 SET Y=$PIECE(DATESTRT,".")
- SET DATEDIS1=$$FMTE^XLFDT(Y,"2DZ")
- +63 SET Y=$PIECE(DATEEND,".")
- SET DATEDIS2=$$FMTE^XLFDT(Y,"2DZ")
- +64 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET NOW=Y
- +65 SET PAGE=1
- SET RCRJLINE=""
- SET $PIECE(RCRJLINE,"-",81)=""
- +66 SET SCREEN=0
- IF '$DATA(ZTQUEUED)
- IF '$GET(RCLSTMGR)
- IF IO=IO(0)
- IF $EXTRACT(IOST)="C"
- SET SCREEN=1
- +67 ; Compile header in to ^TMP for use in report or ListMan
- DO HDR
- +68 USE IO
- if '$GET(RCLSTMGR)
- DO H
- +69 SET CNT=0
- +70 SET RCIX=0
- FOR
- SET RCIX=$ORDER(^TMP($JOB,"RCDPRLIS","SORT",RCIX))
- if RCIX=""!($GET(RCRJFLAG))
- QUIT
- Begin DoDot:1
- +71 SET RCRECTDA=0
- FOR
- SET RCRECTDA=$ORDER(^TMP($JOB,"RCDPRLIS","SORT",RCIX,RCRECTDA))
- if 'RCRECTDA!($GET(RCRJFLAG))
- QUIT
- Begin DoDot:2
- +72 SET DATA=^TMP($JOB,"RCDPRLIS","SORT",RCIX,RCRECTDA)
- +73 SET DATE=$PIECE(DATA,"^",2)
- +74 SET CNT=CNT+1
- +75 SET XX=""
- +76 ; line number (for listman)
- IF RCLSTMGR
- SET XX=" "_$EXTRACT(CNT_SPACE,1,4)_" "
- +77 ; date opened
- SET XX=XX_$$FMTE^XLFDT(DATE,"2ZD")_" "
- +78 ; receipt number
- SET XX=XX_$EXTRACT($PIECE(DATA,"^",1)_SPACE,1,12)_" "
- +79 ; payment type PRCA*4.5*332
- SET XX=XX_$EXTRACT($PIECE(DATA,"^",3)_SPACE,1,$SELECT(RCLSTMGR:5,1:6))_" "
- +80 ; user initials PRCA*4.5*332
- SET XX=XX_$EXTRACT($PIECE(DATA,"^",4)_SPACE,1,7)_" "
- +81 ; payment count
- SET XX=XX_$JUSTIFY($PIECE(DATA,"^",5),5)
- +82 ; payment amount
- SET XX=XX_$JUSTIFY($PIECE(DATA,"^",6),$SELECT(RCLSTMGR:11,1:13),2)_" "
- +83 ; pre lockbox
- SET XX=XX_$EXTRACT($PIECE(DATA,"^",7)_SPACE,1)
- +84 ; fms cr document
- SET XX=XX_$EXTRACT($PIECE(DATA,"^",8)_SPACE,1,16)_" "
- +85 ; fms cr doc status
- SET XX=XX_$EXTRACT($PIECE(DATA,"^",9),1,6)
- +86 ;
- +87 ; Write line or put it to global
- +88 ;
- IF '$GET(RCLSTMGR)
- Begin DoDot:3
- +89 WRITE !,XX
- End DoDot:3
- +90 ;
- IF '$TEST
- Begin DoDot:3
- +91 SET ^TMP($JOB,"RCDPRLIS",CNT)=XX
- +92 ; Cross reference line# vs file 344 DA
- SET ^TMP($JOB,"RCDPRLIS","IDX",CNT)=$PIECE(DATA,"^",10)
- End DoDot:3
- +93 ;
- +94 ; set pre lockbox flag to 1 to show note at end of report
- +95 IF $PIECE(DATA,"^",7)="*"
- SET RCDPFPRE=1
- +96 ;
- +97 IF '$GET(RCLSTMGR)
- IF $Y>(IOSL-6)
- if SCREEN
- DO PAUSE^RCRJRTR1
- if $GET(RCRJFLAG)
- QUIT
- DO H
- End DoDot:2
- End DoDot:1
- +98 ;
- +99 ; PRCA*4.5*321 - Totals don't have a place in a protocol list with actions
- IF $GET(RCLSTMGR)
- QUIT
- +100 ;
- +101 IF $GET(RCRJFLAG)
- DO CLEAN
- QUIT
- +102 IF $GET(RCDPFPRE)
- WRITE !?54,"*CR tied to deposit"
- +103 WRITE !?33,"------ -----------"
- +104 WRITE !?33,$JUSTIFY($PIECE($GET(TOTALS),"^"),6),$JUSTIFY($PIECE($GET(TOTALS),"^",2),13,2)
- +105 ;
- +106 ; show totals by type of payment
- +107 WRITE !!,"TOTALS BY TYPE OF PAYMENT"
- +108 WRITE !,"-------------------------"
- +109 SET TYPE=""
- FOR
- SET TYPE=$ORDER(TOTALS(TYPE))
- if TYPE=""!($GET(RCRJFLAG))
- QUIT
- Begin DoDot:1
- +110 WRITE !,TYPE,?33,$JUSTIFY($PIECE(TOTALS(TYPE),"^"),6),$JUSTIFY($PIECE(TOTALS(TYPE),"^",2),13,2)
- +111 IF $Y>(IOSL-6)
- if SCREEN
- DO PAUSE^RCRJRTR1
- if $GET(RCRJFLAG)
- QUIT
- DO H
- End DoDot:1
- +112 ;
- +113 WRITE !!,"*** END OF REPORT ***",!
- +114 ;
- +115 IF $GET(RCRJFLAG)
- DO CLEAN
- QUIT
- +116 IF SCREEN
- USE IO(0)
- READ !,"Press RETURN to continue:",%:DTIME
- +117 ;
- +118 IF '$GET(RCLSTMGR)
- DO CLEAN
- +119 QUIT
- +120 ;
- RCPTTL(RCRECTDA) ; Returns the Total Amount of all of the Receipt Transactions
- +1 ; PRCA*4.5*349 - Added Method
- +2 ; Input: RCRECTDA - IEN of the Receipt (#344)
- +3 ; Returns: Total Amount of all of the Receipt Transactions
- +4 NEW TOTAL,X
- +5 SET X=0
- SET TOTAL=0
- +6 FOR
- Begin DoDot:1
- +7 SET X=$ORDER(^RCY(344,+$GET(RCRECTDA),1,X))
- if 'X
- QUIT
- +8 SET TOTAL=TOTAL+$PIECE($GET(^(X,0)),"^",4)
- End DoDot:1
- if 'X
- QUIT
- +9 QUIT TOTAL
- +10 ;
- 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)
- +2 ; Returns: 6 character (max) event type abbreviation
- +3 IF AREVENT="EDI LOCKBOX"
- QUIT "EDI"
- +4 IF AREVENT="CASH PAYMENT"
- QUIT "CASH"
- +5 IF AREVENT="CHECK/MO PAYMENT"
- QUIT "CHECK"
- +6 IF AREVENT="LOCKBOX"
- QUIT "LOCKBX"
- +7 QUIT $EXTRACT(AREVENT,1,6)
- +8 ;
- 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
- +2 ; Returns: 9 character (max) status
- +3 SET STATUS=$PIECE(STATUS," ",1)
- +4 IF STATUS="TRANSMITTED"
- QUIT "XMIT"
- +5 IF STATUS="ACCEPTED"
- QUIT "ACCEPT"
- +6 IF STATUS="REJECTED"
- QUIT "REJECT"
- +7 IF STATUS="NOT"
- QUIT "NOTENT"
- +8 IF STATUS="ON"
- QUIT "ONLINE"
- +9 QUIT STATUS
- +10 ;
- CLEAN ; Clean up ^TMP arrays
- +1 DO ^%ZISC
- +2 KILL ^TMP($JOB,"RCDPRLIS")
- +3 QUIT
- +4 ;
- SORTSEL() ; Select sort order for report, by Date Opened, FMS Status or Payment Type
- +1 ; Input: None
- +2 ; Return: Sort Type D - Date, F - FMS Status, T - Payment Type
- +3 NEW DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT,RCREP
- +4 WRITE !
- +5 SET DIR(0)="SOA^D:Date;F:FMS Status;T:Type of payment"
- +6 SET DIR("A")="Sort By (D)ATE OPENED, (F)MS STATUS OR (T)YPE OF PAYMENT: "
- +7 SET DIR("B")="D"
- +8 SET DIR("?",1)="Select the order you wish the receipts to appear in on the report."
- +9 SET DIR("?",2)=" "
- +10 SET DIR("?",3)=" D - Sort by the date the receipt was opened"
- +11 SET DIR("?",4)=" S - Sort by the FMS Status"
- +12 SET DIR("?")=" T - Sort by the Payment Type"
- +13 DO ^DIR
- +14 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
- SET RETURN=-1
- +15 IF '$TEST
- SET RETURN=Y
- +16 QUIT RETURN
- +17 ;
- SELFILTF(RETURN) ; Ask if user want to filter by FMS status. If yes get list of status.
- +1 ; Input: None
- +2 ; Output: RETURN, passed by reference
- +3 ; RETURN - 1=Filter by FMS Status, 0=Don't
- +4 ; RETURN(STATUS) - array of FMS Status to include in the report
- +5 ;
- +6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,J,QUIT,RCODES,RCOUT,X,Y
- +7 KILL RETURN
- +8 SET RETURN=0
- +9 ;
- +10 WRITE !
- +11 SET DIR(0)="YA"
- +12 SET DIR("A")="Filter by FMS Status? (Y/N): "
- +13 SET DIR("B")="NO"
- +14 SET DIR("?",1)="Enter 'Y' or 'Yes' to only show receipts with selected FMS Status"
- +15 SET DIR("?",2)="Enter 'N' or 'No' if you wish to show receipts including all FMS Status"
- +16 SET DIR("?")="If you select yes, you will be prompted for the FMS Status' you wish to include"
- +17 DO ^DIR
- +18 IF $DATA(DIRUT)
- SET RETURN=-1
- QUIT
- +19 IF Y=0
- QUIT
- +20 SET RETURN=1
- +21 ;
- +22 ; Prompt for status' to be included. Multi-select
- +23 WRITE !
- +24 DO FIELD^DID(2100.1,3,"","POINTER","RCOUT")
- +25 SET RCODES=RCOUT("POINTER")
- +26 ; Add pseudo codes to list for "NOT ENTERED" and "ON LINE ENTRY" returned by FMSSTAT^RCDPUREC
- +27 IF $EXTRACT(RCODES,$LENGTH(RCODES))'=";"
- SET RCODES=RCODES_";"
- +28 SET RCODES=RCODES_"O:ON LINE ENTRY;N:NOT ENTERED"
- +29 KILL DIR
- +30 SET DIR(0)="SOA^"_RCODES
- +31 SET DIR("A")="Select an FMS Status to include in the report: "
- +32 KILL DIR("?")
- +33 SET DIR("?",1)="Select an FMS Status to show in the report."
- +34 SET DIR("?",2)="You will be prompted multiple times, until you hit ENTER"
- +35 SET DIR("?")="without making a selection."
- +36 SET QUIT=0
- +37 FOR
- Begin DoDot:1
- +38 WRITE !
- +39 DO ^DIR
- +40 IF $DATA(DTOUT)!$DATA(DUOUT)
- KILL RETURN
- SET RETURN=-1
- SET QUIT=1
- QUIT
- +41 IF Y=""
- SET QUIT=1
- QUIT
- +42 SET RETURN(Y(0))=""
- +43 ; Rebuid DIR(0) to only include codes not yet selected
- +44 SET DIR(0)=$$BLDS(RCODES,.RETURN)
- +45 ; All status selected so stop prompting.
- IF $PIECE(DIR(0),"^",2)=""
- SET QUIT=1
- End DoDot:1
- IF QUIT
- QUIT
- +46 IF RETURN=-1
- QUIT
- +47 ; If no FMS Status' were selected, don't filter by it.
- +48 ;
- IF $ORDER(RETURN(""))=""
- Begin DoDot:1
- +49 SET RETURN=0
- +50 WRITE !!,"No FMS Status' were selected. All FMS Status' will be shown",!
- End DoDot:1
- +51 QUIT
- +52 ;
- SELFILTT(RETURN) ; Ask if user want to filter by Payment Type. If yes get list of types.
- +1 ; Input: None
- +2 ; Output: RETURN, passed by reference
- +3 ; RETURN - 1=Filter by FMS Status, 0=Don't
- +4 ; RETURN(STATUS) - array of FMS Status to include in the report
- +5 ;
- +6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCODES,RCIEN,RCNAME,QUIT,X,Y
- +7 KILL RETURN
- +8 SET RETURN=0
- +9 ;
- +10 WRITE !
- +11 SET DIR(0)="YA"
- +12 SET DIR("A")="Filter by Payment Type? (Y/N): "
- +13 SET DIR("B")="NO"
- +14 SET DIR("?",1)="Enter 'Y' or 'Yes' to only show receipts with selected Payment Types"
- +15 SET DIR("?",2)="Enter 'N' or 'No' if you wish to show receipts including all Payment Types"
- +16 SET DIR("?")="If you select yes, you will be prompted for the Payment Types you wish to include"
- +17 DO ^DIR
- +18 IF $DATA(DIRUT)
- SET RETURN=-1
- QUIT
- +19 IF Y=0
- QUIT
- +20 SET RETURN=1
- +21 ;
- +22 ; Prompt for types to be included. Multi-select
- +23 WRITE !
- +24 KILL DIR
- +25 ; Present payment types as a set of codes to streamline user interface/selection/help
- +26 SET (RCODES,RCNAME)=""
- +27 ;
- FOR
- SET RCNAME=$ORDER(^RC(341.1,"B",RCNAME))
- if RCNAME=""
- QUIT
- Begin DoDot:1
- +28 ;
- SET RCIEN=0
- FOR
- SET RCIEN=$ORDER(^RC(341.1,"B",RCNAME,RCIEN))
- if 'RCIEN
- QUIT
- Begin DoDot:2
- +29 ;
- IF $$GET1^DIQ(341.1,RCIEN_",",.06,"I")=1
- Begin DoDot:3
- +30 SET RCODES=RCODES_":"_$$GET1^DIQ(341.1,RCIEN_",",.01,"E")_";"
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +31 SET DIR(0)="SOA^"_RCODES
- +32 SET DIR("A")="Select a Payment Type to include in the report: "
- +33 KILL DIR("?")
- +34 SET DIR("?",1)="Select an Payment Type to include in the report."
- +35 SET DIR("?",2)="You will be prompted multiple times, until you hit ENTER"
- +36 SET DIR("?")="without making a selection."
- +37 SET QUIT=0
- +38 FOR
- Begin DoDot:1
- +39 WRITE !
- +40 DO ^DIR
- +41 IF $DATA(DTOUT)!$DATA(DUOUT)
- KILL RETURN
- SET RETURN=-1
- SET QUIT=1
- QUIT
- +42 IF $GET(Y(0))=""
- SET QUIT=1
- QUIT
- +43 SET RETURN(Y(0))=""
- +44 ; Rebuid DIR(0) to only include codes not yet selected
- +45 SET DIR(0)=$$BLDS(RCODES,.RETURN)
- +46 ; All status selected so stop prompting.
- IF $PIECE(DIR(0),"^",2)=""
- SET QUIT=1
- End DoDot:1
- IF QUIT
- QUIT
- +47 ;
- +48 IF RETURN=-1
- QUIT
- +49 ; If no payment types were selected, don't filter by it.
- +50 ;
- IF $ORDER(RETURN(""))=""
- Begin DoDot:1
- +51 SET RETURN=0
- +52 WRITE !!,"No Payment Types were selected. Filter will not be used",!
- End DoDot:1
- +53 QUIT
- +54 ;
- 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;
- +2 ; PICKED - Array of values already picked, subscripted by external value e.g. PICKED("Apple")=""
- +3 ; Return: RETURN in DIR(0) format. Set of codes that only includes ones not picked.
- +4 ; e.g "SAO^B:Ball"
- +5 ;
- +6 NEW RETURN
- +7 SET RETURN="SOA^"
- +8 ;
- FOR J=1:1:$LENGTH(CODES,";")
- Begin DoDot:1
- +9 SET X=$PIECE($PIECE(CODES,";",J),":",2)
- +10 IF X'=""
- IF '$DATA(PICKED(X))
- SET RETURN=RETURN_$PIECE(CODES,";",J)_";"
- End DoDot:1
- +11 QUIT RETURN
- +12 ;
- HDR ; Compile header into ^TMP for use in ListMan or report
- +1 ; Input: None
- +2 ; Output: Header information in ^TMP($J,"RCDPRLIS","HDR",n) for us in report or ListMan formats
- +3 NEW K,XX
- +4 SET ^TMP($JOB,"RCDPRLIS","HDR",1)="LIST OF RECEIPTS REPORT"
- +5 SET XX=" DATE RANGE : "_DATEDIS1_" TO "_DATEDIS2_" "
- +6 SET XX=XX_"SORT ORDER: "_$SELECT(RCSORT="D":"DATE OPENED",RCSORT="F":"FMS STATUS",1:"PAYMENT TYPE")
- +7 SET ^TMP($JOB,"RCDPRLIS","HDR",2)=XX
- +8 ;
- +9 ;
- IF 'RCFILTF
- Begin DoDot:1
- +10 SET XX="ALL"
- End DoDot:1
- +11 ;
- IF '$TEST
- Begin DoDot:1
- +12 SET XX=""
- +13 SET K=""
- FOR
- SET K=$ORDER(RCFILTF(K))
- if K=""
- QUIT
- if XX'=""
- SET XX=XX_"; "
- SET XX=XX_K
- End DoDot:1
- +14 SET ^TMP($JOB,"RCDPRLIS","HDR",3)=" FMS STATUS : "_$SELECT($LENGTH(XX)>63:"SELECTED",1:XX)
- +15 ;
- +16 ;
- IF 'RCFILTT
- Begin DoDot:1
- +17 SET XX="ALL"
- End DoDot:1
- +18 ;
- IF '$TEST
- Begin DoDot:1
- +19 SET XX=""
- +20 SET K=""
- FOR
- SET K=$ORDER(RCFILTT(K))
- if K=""
- QUIT
- if XX'=""
- SET XX=XX_"; "
- SET XX=XX_K
- End DoDot:1
- +21 SET ^TMP($JOB,"RCDPRLIS","HDR",4)=" PAYMENT TYPES: "_$SELECT($LENGTH(XX)>63:"SELECTED",1:XX)
- +22 ; PRCA*4.5*332
- +23 SET ^TMP($JOB,"RCDPRLIS","HDR",5)="DATE RECEIPT TYPE USER COUNT AMOUNT FMS CR DOC STATUS"
- +24 WRITE !,RCRJLINE
- +25 QUIT
- +26 ;
- H ; header
- +1 NEW %
- +2 SET %=NOW_" PAGE "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +3 WRITE $CHAR(13),^TMP($JOB,"RCDPRLIS","HDR",1),?(80-$LENGTH(%)),%
- +4 WRITE !,^TMP($JOB,"RCDPRLIS","HDR",2)
- +5 WRITE !,^TMP($JOB,"RCDPRLIS","HDR",3)
- +6 WRITE !,^TMP($JOB,"RCDPRLIS","HDR",4)
- +7 WRITE !,^TMP($JOB,"RCDPRLIS","HDR",5)
- +8 WRITE !,RCRJLINE
- +9 QUIT