source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRLIS.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1RCDPRLIS ;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 ;
17DQ ; 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 ;
88Q D ^%ZISC
89 K ^TMP("RCDPRLIS",$J)
90 Q
91 ;
92 ;
93H ; 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
Note: See TracBrowser for help on using the repository browser.