1 | RCDPRLIS ;WISC/RFJ-list of receipts report ;1 Jun 99
|
---|
2 | ;;4.5;Accounts Receivable;**114**;Mar 20, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | N DATEEND,DATESTRT
|
---|
6 | W !
|
---|
7 | D DATESEL^RCRJRTRA("RECEIPT Opened")
|
---|
8 | I '$G(DATESTRT)!('$G(DATEEND)) Q
|
---|
9 | ;
|
---|
10 | ; select device
|
---|
11 | W ! S %ZIS="Q" D ^%ZIS I POP Q
|
---|
12 | I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
|
---|
13 | . S ZTDESC="List of Receipts",ZTRTN="DQ^RCDPRLIS"
|
---|
14 | . S ZTSAVE("DATE*")="",ZTSAVE("ZTREQ")="@"
|
---|
15 | W !!,"<*> please wait <*>"
|
---|
16 | ;
|
---|
17 | DQ ; queued report starts here
|
---|
18 | N %I,DATA,DATE,DATEDIS1,DATEDIS2,FMSDOCNO,NOW,PAGE,RCDPDATA,RCDPFPRE,RCRECTDA,RCRJFLAG,RCRJLINE,SCREEN,TOTALS,TYPE,X,Y
|
---|
19 | K ^TMP("RCDPRLIS",$J)
|
---|
20 | S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,RCRECTDA)) Q:'RCRECTDA D
|
---|
21 | . K RCDPDATA
|
---|
22 | . D DIQ344^RCDPRPLM(RCRECTDA,".01:200")
|
---|
23 | . S RCDPDATA(344,RCRECTDA,.03,"I")=$P(RCDPDATA(344,RCRECTDA,.03,"I"),".")
|
---|
24 | . I RCDPDATA(344,RCRECTDA,.03,"I")<DATESTRT Q
|
---|
25 | . I $P(RCDPDATA(344,RCRECTDA,.03,"I"),".")>DATEEND Q
|
---|
26 | . ; get fms document ^ status ^ pre lockbox patch
|
---|
27 | . S FMSDOCNO=$$FMSSTAT^RCDPUREC(RCRECTDA)
|
---|
28 | . ; compute totals by type
|
---|
29 | . I RCDPDATA(344,RCRECTDA,.04,"E")="" S RCDPDATA(344,RCRECTDA,.04,"E")="UNKNOWN"
|
---|
30 | . S $P(TOTALS(RCDPDATA(344,RCRECTDA,.04,"E")),"^",1)=$P($G(TOTALS(RCDPDATA(344,RCRECTDA,.04,"E"))),"^",1)+RCDPDATA(344,RCRECTDA,101,"E")
|
---|
31 | . S $P(TOTALS(RCDPDATA(344,RCRECTDA,.04,"E")),"^",2)=$P($G(TOTALS(RCDPDATA(344,RCRECTDA,.04,"E"))),"^",2)+RCDPDATA(344,RCRECTDA,.15,"E")
|
---|
32 | . S $P(TOTALS,"^",1)=$P($G(TOTALS),"^",1)+RCDPDATA(344,RCRECTDA,101,"E")
|
---|
33 | . S $P(TOTALS,"^",2)=$P($G(TOTALS),"^",2)+RCDPDATA(344,RCRECTDA,.15,"E")
|
---|
34 | . ; opened by
|
---|
35 | . I RCDPDATA(344,RCRECTDA,.02,"E")'="" D
|
---|
36 | . . S RCDPDATA(344,RCRECTDA,.02,"E")=$E($P(RCDPDATA(344,RCRECTDA,.02,"E"),",",2))_$E(RCDPDATA(344,RCRECTDA,.02,"E"))
|
---|
37 | . . I RCDPDATA(344,RCRECTDA,.02,"I")=.5 S RCDPDATA(344,RCRECTDA,.02,"E")="ar"
|
---|
38 | . ;
|
---|
39 | . S DATA=RCDPDATA(344,RCRECTDA,.01,"E")
|
---|
40 | . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,.04,"E") ;payment type
|
---|
41 | . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,.02,"E") ;user initials
|
---|
42 | . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,101,"E") ;payment count
|
---|
43 | . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,.15,"E") ;payment amount
|
---|
44 | . S DATA=DATA_"^"_$S($P(FMSDOCNO,"^",3):"*",1:" ") ;pre lockbox
|
---|
45 | . S DATA=DATA_"^"_$P(FMSDOCNO,"^") ;fms cr document
|
---|
46 | . S DATA=DATA_"^"_$P(FMSDOCNO,"^",2) ;fms cr doc status
|
---|
47 | . S ^TMP("RCDPRLIS",$J,RCDPDATA(344,RCRECTDA,.03,"I"),RCRECTDA)=DATA
|
---|
48 | ;
|
---|
49 | S Y=$P(DATESTRT,".") D DD^%DT S DATEDIS1=Y
|
---|
50 | S Y=$P(DATEEND,".") D DD^%DT S DATEDIS2=Y
|
---|
51 | D NOW^%DTC S Y=% D DD^%DT S NOW=Y
|
---|
52 | S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)=""
|
---|
53 | S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
|
---|
54 | U IO D H
|
---|
55 | S DATE=0 F S DATE=$O(^TMP("RCDPRLIS",$J,DATE)) Q:'DATE!($G(RCRJFLAG)) D
|
---|
56 | . S RCRECTDA=0 F S RCRECTDA=$O(^TMP("RCDPRLIS",$J,DATE,RCRECTDA)) Q:'RCRECTDA!($G(RCRJFLAG)) D
|
---|
57 | . . S DATA=^TMP("RCDPRLIS",$J,DATE,RCRECTDA)
|
---|
58 | . . W !,$E(DATE,4,5),"/",$E(DATE,6,7),"/",$E(DATE,2,3)
|
---|
59 | . . W ?10,$P(DATA,"^")
|
---|
60 | . . W ?21,$E($P($P(DATA,"^",2)," "),1,8) ;payment type
|
---|
61 | . . W ?31,$E($P(DATA,"^",3),1,2) ;user initials
|
---|
62 | . . W ?33,$J($P(DATA,"^",4),6) ;payment count
|
---|
63 | . . W $J($P(DATA,"^",5),13,2) ;payment amount
|
---|
64 | . . W ?54,$P(DATA,"^",6) ;pre lockbox
|
---|
65 | . . W ?55,$P(DATA,"^",7) ;fms cr document
|
---|
66 | . . W ?71,$E($P(DATA,"^",8),1,9) ;fms cr doc status
|
---|
67 | . . ;
|
---|
68 | . . ; set pre lockbox flag to 1 to show note at end of report
|
---|
69 | . . I $P(DATA,"^",6)="*" S RCDPFPRE=1
|
---|
70 | . . ;
|
---|
71 | . . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
|
---|
72 | ;
|
---|
73 | I $G(RCRJFLAG) D Q Q
|
---|
74 | I $G(RCDPFPRE) W !?54,"*CR tied to deposit"
|
---|
75 | W !?33,"------ -----------"
|
---|
76 | W !?33,$J($P($G(TOTALS),"^"),6),$J($P($G(TOTALS),"^",2),13,2)
|
---|
77 | ;
|
---|
78 | ; show totals by type of payment
|
---|
79 | W !!,"TOTALS BY TYPE OF PAYMENT"
|
---|
80 | W !,"-------------------------"
|
---|
81 | S TYPE="" F S TYPE=$O(TOTALS(TYPE)) Q:TYPE=""!($G(RCRJFLAG)) D
|
---|
82 | . W !,TYPE,?33,$J($P(TOTALS(TYPE),"^"),6),$J($P(TOTALS(TYPE),"^",2),13,2)
|
---|
83 | . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
|
---|
84 | ;
|
---|
85 | I $G(RCRJFLAG) D Q Q
|
---|
86 | I SCREEN U IO(0) R !,"Press RETURN to continue:",%:DTIME
|
---|
87 | ;
|
---|
88 | Q D ^%ZISC
|
---|
89 | K ^TMP("RCDPRLIS",$J)
|
---|
90 | Q
|
---|
91 | ;
|
---|
92 | ;
|
---|
93 | H ; header
|
---|
94 | S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
---|
95 | W $C(13),"LIST OF RECEIPTS REPORT",?(80-$L(%)),%
|
---|
96 | W !," FOR THE DATE RANGE: ",DATEDIS1," TO ",DATEDIS2
|
---|
97 | W !,"DATE",?10,"RECEIPT",?21,"TYPE",?31,"US",?33,$J("COUNT",6),$J("AMOUNT",13),?55,"FMS CR DOC",?71,"STATUS"
|
---|
98 | W !,RCRJLINE
|
---|
99 | Q
|
---|