source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCTRAN.m@ 876

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1RCTRAN ;WASH-ISC@ALTOONA,PA/LDB-Transaction History Report ;1/19/95 4:33 PM
2V ;;4.5;Accounts Receivable;**104,154**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 N AMT,APP,BDATE,BILL,BY,CAT,DIC,DIR,DIRUT,EDATE,FUND,LINE,LN,NODE0,NODE1,NODE2,NODE3,PG,POP,PX2,RCX,RCX1,TDAT,TYP
5 N X,X1,X11,X12,X1A,X2,X3,XFND,XF1,Y,ZTDESC,ZTRTN,ZTSAVE,%ZIS
6EN S X=$$DATE^RCEVUTL1("")
7 Q:X<0
8 S BDATE=+X,EDATE=$P(X,"^",2)
9TYPE S DIC="^PRCA(430.3,",DIC(0)="QEMZ",DIC("S")="I +Y,(Y<15!(""25^29^34^35^40^41^43^45^46^47""[(""^""_+Y_""^"")))"
10 S Y=0 W !,"TRANSACTION TYPE: "_$S('$O(TYP("")):"ALL// ",1:"")
11 R X:DTIME I '$T!(X="^") Q
12 I ((X="")!(X="ALL")),'$O(TYP("")) S (TYP,X)="ALL" G CAT
13 I X="" G CAT
14 I X'="ALL" D ^DIC S TYP=+Y
15 I X["?" W !!,"Enter 'ALL' for all types of transactions in the AR TRANSACTION TYPE FILE",! G TYPE
16 ;I $P($G(^PRCA(430.3,+Y,0)),"^",3)>100 W !!,"This is a STATUS. Enter a transaction type only.",! G TYPE
17 I TYP'="ALL",(+TYP>0) S TYP(+TYP)="" G TYPE
18 G:+TYP<0 TYPE
19CAT K DIC S Y=0 W !,"CATEGORY OF BILL: "_$S('$O(CAT("")):"ALL// ",1:"")
20 R X:DTIME I '$T!(X="^") Q
21 I ((X="")!(X="ALL")),'$O(CAT("")) S (CAT,X)="ALL" G DEV
22 I X="" G DEV
23 I X'="ALL" S DIC="^PRCA(430.2,",DIC(0)="QEMZ" D ^DIC S CAT=+Y
24 I X["?" W !!,"Enter 'ALL' for all categories of bills.",! G CAT
25 I CAT'="ALL",(+CAT>0) S CAT(+CAT)="" G CAT
26 G:+CAT<0 CAT
27DEV W !!,"This report takes a long time to compile."
28 W !,"It is recommended that it be queued to print later.",!!
29 S %ZIS="AEQ" D ^%ZIS G:POP EXIT
30 I $D(IO("Q")) D Q
31 .S ZTSAVE("BDATE")="",ZTSAVE("EDATE")="",ZTSAVE("TYP")="",ZTSAVE("CAT")="",ZTRTN="DQ^RCTRAN",ZTDESC="Transaction History Report"
32 .S:$O(TYP("")) ZTSAVE("TYP(")=""
33 .S:$O(CAT("")) ZTSAVE("CAT(")=""
34 .D ^%ZTLOAD,^%ZISC,EXIT K ZTSAVE,ZTRTN Q
35 ;
36DQ ;Call to build array of payment transactions
37 ;
38 U IO
39 D DT^DICRW W:$E(IOST,1,2)'="P-" @IOF S PG=0,LINE="",$P(LINE,"-",79)=""
40 K ^TMP($J) D TRANS^RCTRAN1
41 I '$D(^TMP($J)) D HDR^RCTRAN1 W !!,"There is no activity of this type during this time period."
42 I $D(^TMP($J)) D PRINT
43 K ^TMP($J) D ^%ZISC
44 Q
45 ;
46PRINT ;Print transactions of type within selected date range
47 D HDR^RCTRAN1
48 S (AMT("TOT"),RCX)=0
49 F S RCX1=RCX,RCX=$O(^TMP($J,RCX)) Q:$D(DIRUT)!'RCX S X11=0 F S X12=X11,X11=$O(^TMP($J,RCX,X11)) Q:$D(DIRUT) Q:'X11 S XFND="" F S XFND=$O(^TMP($J,RCX,X11,XFND)) Q:$D(DIRUT)!(XFND="") D FCHK D
50 .S AMT(X11)=0,X2=0,PX2=X2 F S X2=$O(^TMP($J,RCX,X11,XFND,X2)) Q:$D(DIRUT) D:'X2 SUB^RCTRAN1 Q:'X2 S X3=0 F S AMT(X11,XFND)=0,X3=$O(^TMP($J,RCX,X11,XFND,X2,X3)) Q:'X3!$D(DIRUT) D
51 ..W:$$SLH^RCFN01(X2)'=$$SLH^RCFN01(PX2)!'LN !,$$SLH^RCFN01(X2)
52 ..W:RCX'=RCX1!'LN ?12,$E($P($G(^PRCA(430.3,+RCX,0)),"^"),1,23)
53 ..W ?37,$P($G(^PRCA(430.2,+X11,0)),"^",2)
54 ..S BILL=$P(^TMP($J,RCX,X11,XFND,X2,X3),"^",2) W ?41,BILL
55 ..W ?55,$J(X3,8)
56 ..S AMT=+^TMP($J,RCX,X11,XFND,X2,X3)
57 ..I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TYP_",") I AMT'<0 S AMT=-AMT
58 ..I ",2,8,9,10,11,12,14,19,47,34,35,29,"'[(","_TYP_",") I AMT<0 S AMT=-AMT
59 ..I +CAT=26,TYP=1 I AMT'<0 S AMT=-AMT
60 ..I +CAT=26,TYP=35 I AMT'<0 S AMT=-AMT
61 ..S AMT("TOT")=AMT("TOT")+AMT
62 ..S AMT(X11)=AMT(X11)+AMT
63 ..S AMT(X11,XFND)=AMT(X11,XFND)+AMT
64 ..S:AMT<0 AMT=-AMT W ?64,$J(AMT,11,2)
65 ..S BY=$P(^TMP($J,RCX,X11,XFND,X2,X3),"^",3) S:BY BY=$P($G(^VA(200,+BY,0)),"^",2)
66 ..W ?76,BY
67 ..I RCX=45 W !?10,$P($G(^PRCA(433,+X3,5)),"^",2),!
68 ..S LN=LN+1
69 ..I $O(^TMP($J,RCX))!TYP,$Y+3>IOSL D
70 ...I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)
71 ...W @IOF D HDR^RCTRAN1
72 Q:$D(DIRUT)
73 I $O(^TMP($J,RCX))!TYP,($Y+10>IOSL) D
74 .I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)
75 .W @IOF D HDR^RCTRAN1
76 Q:$D(DIRUT)
77 S:AMT("TOT")<0 AMT("TOT")=-AMT("TOT") W:TYP !?64,"------------",!,?57,"TOTAL:",?64,$J(AMT("TOT"),12,2)
78 D KEY^RCTRAN1
79 Q
80 ;
81FCHK ;Check fund
82 W !,"FUND: ",XFND
83 Q
84 ;
85EXIT ;Exit routine
86 K ^TMP($J) D ^%ZISC Q
Note: See TracBrowser for help on using the repository browser.