source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRTRA.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1RCRJRTRA ;WISC/RFJ-transaction report ;1 Mar 97
2 ;;4.5;Accounts Receivable;**68,153**;Mar 20, 1995
3 N DATEEND,DATESTRT,RCRJSUMM,TRANTYPE
4 ;
5 ; select date range
6 D DATESEL("AR TRANSACTIONS") I '$G(DATEEND) Q
7 S DATEEND=DATEEND+.99
8 ;
9 ; select transaction types
10 D TRANTYPE(DATESTRT,DATEEND) I '$O(TRANTYPE(0)) W !,"NO transaction types selected." Q
11 ;
12 S RCRJSUMM=$$SUMMARY I 'RCRJSUMM Q
13 ;
14 ; select device
15 W ! S %ZIS="Q" D ^%ZIS Q:POP
16 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
17 . S ZTDESC="AR Transaction Listing Report",ZTRTN="DQ^RCRJRTRA"
18 . S ZTSAVE("DATE*")="",ZTSAVE("RCRJ*")="",ZTSAVE("TRANTYPE*")="",ZTSAVE("ZTREQ")="@"
19 W !!,"<*> please wait <*>"
20 ;
21DQ ; report (queue) starts here
22 N ADM,BILLDA,CATDA,DA,DATA0,DATE,INT,PRIN,TYPE,VALUE,X,Y
23 K ^TMP($J,"RCRJRTRA")
24 ;
25 S TRANTYPE=0 F S TRANTYPE=$O(TRANTYPE(TRANTYPE)) Q:'TRANTYPE I $D(^PRCA(433,"AT",TRANTYPE)) D
26 . S DATE=DATESTRT-.01 F S DATE=$O(^PRCA(433,"AT",TRANTYPE,DATE)) Q:'DATE!(DATE>DATEEND) D
27 . . S DA=0 F S DA=$O(^PRCA(433,"AT",TRANTYPE,DATE,DA)) Q:'DA D
28 . . . S DATA0=$G(^PRCA(433,DA,0))
29 . . . ;
30 . . . S BILLDA=+$P(DATA0,"^",2)
31 . . . ; bill not linked to a site
32 . . . I '$P($G(^PRCA(430,BILLDA,0)),"^",12) Q
33 . . . ;
34 . . . S CATDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
35 . . . I 'CATDA Q
36 . . . ;
37 . . . S VALUE=$$TRANBAL^RCRJRCOT(DA) I VALUE="" Q
38 . . . S PRIN=$P(VALUE,"^"),INT=$P(VALUE,"^",2),ADM=$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5)
39 . . . ;
40 . . . S TYPE=TRANTYPE
41 . . . ; contract adjustment
42 . . . I TYPE=35,$P($G(^PRCA(433,DA,8)),"^",8) S TYPE="35C"
43 . . . ; pre-payments
44 . . . I (TYPE=2!(TYPE=34)),$P($G(^PRCA(433,DA,5)),"^") S TYPE="34P"
45 . . . ;
46 . . . I TYPE'=12 D SETVALUE(TYPE,PRIN,INT,ADM) Q
47 . . . ;
48 . . . ; if trans is 12, breakout charges added + and exempt -
49 . . . ; both +, charges added
50 . . . I INT'<0,ADM'<0 D SETVALUE("12A","",INT,ADM) Q
51 . . . ; both -, charges exempt
52 . . . I INT<0,ADM<0 D SETVALUE("12E","",-INT,-ADM) Q
53 . . . ; one is + and the other -
54 . . . I INT<0 D:ADM SETVALUE("12A","","",ADM) D SETVALUE("12E","",-INT,"") Q
55 . . . I ADM<0 D:INT SETVALUE("12A","",INT,"") D SETVALUE("12E","","",-ADM) Q
56 ;
57 D PRINT^RCRJRTR1
58 ;
59 D ^%ZISC
60 K ^TMP($J,"RCRJRTRA")
61 Q
62 ;
63 ;
64SETVALUE(TYPE,PRIN,INT,ADM) ; store value in tmp global for printing
65 ; = trans amt ^ prin amt ^ int amt ^ adm amt
66 ; add spaces to type for sorting in numerical order
67 S TYPE=" "_$S($L(+TYPE)=1:" ",1:"")_TYPE
68 S ^TMP($J,"RCRJRTRA",TYPE,CATDA,BILLDA,DA)=(PRIN+INT+ADM)_"^"_PRIN_"^"_INT_"^"_ADM
69 Q
70 ;
71 ;
72DATESEL(DESCR) ; select starting and ending dates in days
73 ; returns datestrt and dateend
74 N %,%DT,%H,%I,DEFAULT,X,Y
75 K DATEEND,DATESTRT
76START S Y=$E(DT,1,5)_"01" D DD^%DT S DEFAULT=Y
77 S %DT("A")="Start with "_$S(DESCR'="":DESCR_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
78 I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
79 S DATESTRT=Y
80 S Y=DT D DD^%DT S DEFAULT=Y
81 S %DT("A")=" End with "_$S(DESCR'="":DESCR_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
82 I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
83 I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",! G START
84 S DATEEND=Y,Y=DATESTRT D DD^%DT
85 W !?5,"*** Selected date range from ",Y," to " S Y=DATEEND D DD^%DT W Y," ***"
86 Q
87 ;
88 ;
89TRANTYPE(DATESTRT,DATEEND) ; select transaction types
90 ; requires datestrt and dateend for date range
91 ; returns TRANTYPE(#) for selected entries
92 N %,COUNT,DATE,DIR,DIRUT,RCRJFLAG,TRANLIST,X,Y
93 K TRANTYPE
94 ;
95 ; compile a list of available transactions in date range
96 S TRANLIST="",DATE=DATESTRT-.01
97 S TRANTYPE=0 F S TRANTYPE=$O(^PRCA(433,"AT",TRANTYPE)) Q:'TRANTYPE S %=+$O(^PRCA(433,"AT",TRANTYPE,DATE)) I %,%<DATEEND D
98 . I TRANTYPE=45 Q ;do not look at comments
99 . S %=$P($G(^PRCA(430.3,TRANTYPE,0)),"^")
100 . S TRANLIST(TRANTYPE)=%
101 . S TRANLIST=TRANLIST_TRANTYPE_":"_$E(%,1,10)_";"
102 I TRANLIST="" W !,"There are NO transactions within the date range." Q
103 S TRANLIST=TRANLIST_"*:ALL transactions;-:NO transactions;"
104 ;
105 F D Q:$G(RCRJFLAG)
106 . D SHOWLIST
107 . S DIR(0)="SOA^"_TRANLIST,DIR("A")="Select TRANSACTION TYPE: "
108 . D ^DIR
109 . I $D(DIRUT) S RCRJFLAG=1 Q
110 . I Y="*" S %=0 F S %=$O(TRANLIST(%)) Q:'% S TRANTYPE(%)=""
111 . I Y="-" K TRANTYPE Q
112 . S Y=+Y
113 . I $D(TRANLIST(Y)) D
114 . . I $D(TRANTYPE(Y)) K TRANTYPE(Y) W " un-selected" Q
115 . . S TRANTYPE(Y)="" W " selected"
116 Q
117 ;
118 ;
119SHOWLIST ; show list of available/selected transaction types
120 W !!,"The following is a list of available transactions within the date range.",!,"Asterisks (**) next to the transaction indicates it has been selected",!,"for the report."
121 S %=0 F COUNT=1:1 S %=$O(TRANLIST(%)) Q:'% D
122 . I (COUNT#2)'=0 W !
123 . E W ?40
124 . W $S($D(TRANTYPE(%)):"**",1:" ")," "
125 . W $S($L(%)=1:" ",1:""),%," ",TRANLIST(%)
126 Q
127 ;
128 ;
129SUMMARY() ; ask to print detailed or summary report
130 N DIR,DIRUT,X,Y
131 S DIR(0)="SOA^D:detailed;S:summary;",DIR("A")="Type of report to print: ",DIR("B")="summary"
132 W ! D ^DIR
133 I $D(DIRUT) Q 0
134 Q $S(Y="S":1,Y="D":2,1:0)
Note: See TracBrowser for help on using the repository browser.