source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCTRAN.m@ 1073

RCTRAN ;WASH-ISC@ALTOONA,PA/LDB-Transaction History Report ;1/19/95  4:33 PM

V ;;4.5;Accounts Receivable;**104,154**;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 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

 N X,X1,X11,X12,X1A,X2,X3,XFND,XF1,Y,ZTDESC,ZTRTN,ZTSAVE,%ZIS

EN S X=$$DATE^RCEVUTL1("")

 Q:X<0

 S BDATE=+X,EDATE=$P(X,"^",2)

TYPE 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_""^"")))"

 S Y=0 W !,"TRANSACTION TYPE: "_$S('$O(TYP("")):"ALL// ",1:"")

 R X:DTIME I '$T!(X="^") Q

 I ((X="")!(X="ALL")),'$O(TYP("")) S (TYP,X)="ALL" G CAT

 I X="" G CAT

 I X'="ALL" D ^DIC S TYP=+Y

 I X["?" W !!,"Enter 'ALL' for all types of transactions in the AR TRANSACTION TYPE FILE",! G TYPE

 ;I $P($G(^PRCA(430.3,+Y,0)),"^",3)>100 W !!,"This is a STATUS. Enter a transaction type only.",! G TYPE

 I TYP'="ALL",(+TYP>0) S TYP(+TYP)="" G TYPE

 G:+TYP<0 TYPE

CAT K DIC S Y=0 W !,"CATEGORY OF BILL: "_$S('$O(CAT("")):"ALL// ",1:"")

 R X:DTIME I '$T!(X="^") Q

 I ((X="")!(X="ALL")),'$O(CAT("")) S (CAT,X)="ALL" G DEV

 I X="" G DEV

 I X'="ALL" S DIC="^PRCA(430.2,",DIC(0)="QEMZ" D ^DIC S CAT=+Y

 I X["?" W !!,"Enter 'ALL' for all categories of bills.",! G CAT

 I CAT'="ALL",(+CAT>0) S CAT(+CAT)="" G CAT

 G:+CAT<0 CAT

DEV W !!,"This report takes a long time to compile."

 W !,"It is recommended that it be queued to print later.",!!

 S %ZIS="AEQ" D ^%ZIS G:POP EXIT

 I $D(IO("Q")) D  Q

 .S ZTSAVE("BDATE")="",ZTSAVE("EDATE")="",ZTSAVE("TYP")="",ZTSAVE("CAT")="",ZTRTN="DQ^RCTRAN",ZTDESC="Transaction History Report"

 .S:$O(TYP("")) ZTSAVE("TYP(")=""

 .S:$O(CAT("")) ZTSAVE("CAT(")=""

 .D ^%ZTLOAD,^%ZISC,EXIT K ZTSAVE,ZTRTN Q

 ;

DQ ;Call to build array of payment transactions

 ;

 U IO

 D DT^DICRW W:$E(IOST,1,2)'="P-" @IOF S PG=0,LINE="",$P(LINE,"-",79)=""

 K ^TMP($J) D TRANS^RCTRAN1

 I '$D(^TMP($J)) D HDR^RCTRAN1 W !!,"There is no activity of this type during this time period."

 I $D(^TMP($J)) D PRINT

 K ^TMP($J) D ^%ZISC

 Q

 ;

PRINT ;Print transactions of type within selected date range

 D HDR^RCTRAN1

 S (AMT("TOT"),RCX)=0

 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

 .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

 ..W:$$SLH^RCFN01(X2)'=$$SLH^RCFN01(PX2)!'LN !,$$SLH^RCFN01(X2)

 ..W:RCX'=RCX1!'LN ?12,$E($P($G(^PRCA(430.3,+RCX,0)),"^"),1,23)

 ..W ?37,$P($G(^PRCA(430.2,+X11,0)),"^",2)

 ..S BILL=$P(^TMP($J,RCX,X11,XFND,X2,X3),"^",2) W ?41,BILL

 ..W ?55,$J(X3,8)

 ..S AMT=+^TMP($J,RCX,X11,XFND,X2,X3)

 ..I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TYP_",") I AMT'<0 S AMT=-AMT

 ..I ",2,8,9,10,11,12,14,19,47,34,35,29,"'[(","_TYP_",") I AMT<0 S AMT=-AMT

 ..I +CAT=26,TYP=1 I AMT'<0 S AMT=-AMT

 ..I +CAT=26,TYP=35 I AMT'<0 S AMT=-AMT

 ..S AMT("TOT")=AMT("TOT")+AMT

 ..S AMT(X11)=AMT(X11)+AMT

 ..S AMT(X11,XFND)=AMT(X11,XFND)+AMT

 ..S:AMT<0 AMT=-AMT W ?64,$J(AMT,11,2)

 ..S BY=$P(^TMP($J,RCX,X11,XFND,X2,X3),"^",3) S:BY BY=$P($G(^VA(200,+BY,0)),"^",2)

 ..W ?76,BY

 ..I RCX=45 W !?10,$P($G(^PRCA(433,+X3,5)),"^",2),!

 ..S LN=LN+1

 ..I $O(^TMP($J,RCX))!TYP,$Y+3>IOSL D

 ...I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)

 ...W @IOF D HDR^RCTRAN1

 Q:$D(DIRUT)

 I $O(^TMP($J,RCX))!TYP,($Y+10>IOSL) D

 .I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)

 .W @IOF D HDR^RCTRAN1

 Q:$D(DIRUT)

 S:AMT("TOT")<0 AMT("TOT")=-AMT("TOT") W:TYP !?64,"------------",!,?57,"TOTAL:",?64,$J(AMT("TOT"),12,2)

 D KEY^RCTRAN1

 Q

 ;

FCHK ;Check fund

 W !,"FUND: ",XFND

 Q

 ;

EXIT ;Exit routine

 K ^TMP($J) D ^%ZISC Q