82 lines
4.7 KiB
Mathematica
82 lines
4.7 KiB
Mathematica
PRCPRVS0 ;WISC/RFJ-voucher summary (continued) ;15 Jun 92
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
PRINT ; print report
|
|
N %,ACCT,ACCTBAL,CC,D,DATE,MONTH,NOW,OPENBAL,P,PAGE,PRCPFLAG,REFNO,SCREEN,TACCISS,TACCISSA,TACCOTH,TACCREC,TACCRECA,TACCT,TRANSID,TRANSNO,TSUPISS,TSUPISSA,TSUPOTH,TSUPREC,TSUPRECA,X,Y
|
|
S Y=DATESTRT D DD^%DT S MONTH=Y
|
|
S SCREEN=$$SCRPAUSE^PRCPUREP,PAGE=1 D NOW^%DTC S Y=% D DD^%DT S NOW=Y U IO
|
|
S (TSUPISS,TSUPISSA,TSUPOTH,TSUPREC,TSUPRECA,ACCT,ACCTBAL,OPENBAL)=""
|
|
F S ACCT=$O(OPEN(ACCT)) Q:'ACCT!($G(PRCPFLAG)) D H D
|
|
. S (TACCISS,TACCISSA,TACCOTH,TACCREC,TACCRECA)=""
|
|
. S $P(OPENBAL,"^")=$P(OPENBAL,"^")+$P(OPEN(ACCT),"^"),$P(OPENBAL,"^",2)=$P(OPENBAL,"^",2)+$P(OPEN(ACCT),"^",2)
|
|
. S REFNO="" F S REFNO=$O(^TMP($J,"PRCPRVSR",ACCT,REFNO)) Q:REFNO=""!($G(PRCPFLAG)) S DATE="" F S DATE=$O(^TMP($J,"PRCPRVSR",ACCT,REFNO,DATE)) Q:'DATE!($G(PRCPFLAG)) D
|
|
. . S TRANSID=0 F S TRANSID=$O(^TMP($J,"PRCPRVSR",ACCT,REFNO,DATE,TRANSID)) Q:(TRANSID)=""!($G(PRCPFLAG)) S D=^(TRANSID) D
|
|
. . . S CC=$E($P(D,"^",3),1,4) I CC'="" S CC=CC_"/"_$P(D,"^",4)
|
|
. . . W !,REFNO,?8,$E(DATE,6,7),?13,$P(D,"^"),?27,$P(D,"^",2),?37,CC,?49,$J($FN($P(D,"^",5),"T+"),9),$$SHOWVALU($P(D,"^",6)),$$SHOWVALU($P(D,"^",7))
|
|
. . . S TRANSNO=$P(D,"^") I TRANSNO="OTHER" D SETVAR("TACCOTH")
|
|
. . . ; set totals for receipts
|
|
. . . I +TRANSNO,$P(TRANSNO,"-",2)="" D
|
|
. . . . I $E($P(D,"^",2))="R" D SETVAR("TACCREC") Q
|
|
. . . . D SETVAR("TACCRECA")
|
|
. . . ; set totals for issues
|
|
. . . I +TRANSNO,$P(TRANSNO,"-",2)'="" D
|
|
. . . . I $E($P(D,"^",2))="R" D SETVAR("TACCISS") Q
|
|
. . . . D SETVAR("TACCISSA")
|
|
. . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|
. . I '$G(PRCPFLAG),$Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|
. . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
|
|
. I $G(PRCPFLAG) Q
|
|
. I $Y>(IOSL-11) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|
. W !!?4,"TOTAL ACCT CODE ISSUES:",?49,$$SHOWTOTL("TACCISS")
|
|
. W !?4,"TOTAL ACCT CODE ISSUE ADJ:",?49,$$SHOWTOTL("TACCISSA")
|
|
. W !?4,"TOTAL ACCT CODE RECEIPTS:",?49,$$SHOWTOTL("TACCREC")
|
|
. W !?4,"TOTAL ACCT CODE RECEIPT ADJ:",?49,$$SHOWTOTL("TACCRECA")
|
|
. W !?4,"TOTAL ACCT CODE OTHER ADJ:",?49,$$SHOWTOTL("TACCOTH")
|
|
. S TACCT="" F %="TACCISS","TACCISSA","TACCOTH","TACCREC","TACCRECA" F P=1:1:3 S $P(TACCT,"^",P)=$P(TACCT,"^",P)+$P(@%,"^",P),X="TSUP"_$E(%,5,8),$P(@X,"^",P)=$P(@X,"^",P)+$P(@%,"^",P)
|
|
. W !!?4,"OPEN BALANCE FOR ACCT CODE '",ACCT,"':",?49,$J($FN($P($G(OPEN(ACCT)),"^"),"T+"),9),$$SHOWVALU($P($G(OPEN(ACCT)),"^",2))
|
|
. W !?4,"TOTALS FOR ACCT CODE '",ACCT,"':",?49,$$SHOWTOTL("TACCT")
|
|
. S %="",$P(%,"^")=$P($G(OPEN(ACCT)),"^")+$P(TACCT,"^"),$P(%,"^",2)=$P($G(OPEN(ACCT)),"^",2)+$P(TACCT,"^",2)
|
|
. S $P(ACCTBAL,"^")=$P(ACCTBAL,"^")+$P(%,"^"),$P(ACCTBAL,"^",2)=$P(ACCTBAL,"^",2)+$P(%,"^",2)
|
|
. W !?4,"CLOSING BALANCE FOR ACCT CODE '",ACCT,"':",?49,$J($FN($P(%,"^"),"T+"),9),$$SHOWVALU($P(%,"^",2))
|
|
. I $O(^TMP($J,"PRCPRVSR",ACCT)) D:SCREEN P^PRCPUREP
|
|
I $G(PRCPFLAG) D Q Q
|
|
I $Y>(IOSL-12) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) S ACCT="END OF REPORT" D H
|
|
W !!,"** TOTAL SUPPLY ISSUES:",?49,$$SHOWTOTL("TSUPISS")
|
|
W !,"** TOTAL SUPPLY ISSUE ADJ:",?49,$$SHOWTOTL("TSUPISSA")
|
|
W !,"** TOTAL SUPPLY RECEIPTS:",?49,$$SHOWTOTL("TSUPREC")
|
|
W !,"** TOTAL SUPPLY RECEIPT ADJ:",?49,$$SHOWTOTL("TSUPRECA")
|
|
W !,"** TOTAL OTHER ADJ:",?49,$$SHOWTOTL("TSUPOTH")
|
|
S TACCT="" F %="TSUPISS","TSUPISSA","TSUPOTH","TSUPREC","TSUPRECA" F P=1:1:3 S $P(TACCT,"^",P)=$P(TACCT,"^",P)+$P(@%,"^",P)
|
|
W !!,"** TOTALS FOR SUPPLY:",?49,$$SHOWTOTL("TACCT")
|
|
W !!,"** OPENING BALANCE FOR SUPPLY:",?49,$J($FN($P(OPENBAL,"^"),"T+"),9),$$SHOWVALU($P(OPENBAL,"^",2))
|
|
W !,"** CLOSING BALANCE FOR SUPPLY:",?49,$J($FN($P(ACCTBAL,"^"),"T+"),9),$$SHOWVALU($P(ACCTBAL,"^",2))
|
|
D END^PRCPUREP
|
|
Q D ^%ZISC K ^TMP($J,"PRCPRVSR") Q
|
|
;
|
|
;
|
|
SETVAR(V1) ;set total variable v1
|
|
F %=1:1:3 S $P(@V1,"^",%)=$P(@V1,"^",%)+$P(D,"^",%+4)
|
|
Q
|
|
;
|
|
;
|
|
SHOWTOTL(V1) ;print totals for variable v1
|
|
Q $J($FN($P(@V1,"^"),"T+"),9)_$$SHOWVALU($P(@V1,"^",2))_$$SHOWVALU($P(@V1,"^",3))
|
|
;
|
|
;
|
|
SHOWVALU(V1) ;show value
|
|
N % S %="+" S:+V1=0 %=" " I V1<0 S V1=-V1,%="-"
|
|
Q $J(V1,10,2)_%
|
|
;
|
|
;
|
|
H ;heading
|
|
S %=NOW_" PAGE: "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|
W $C(13),"VOUCHER SUMMARY REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
|
|
W !?5,"TRANSACTIONS FOR THE MONTH-YEAR: ",MONTH
|
|
W !?4,"ACCOUNT CODE: ",ACCT,?30,"STA-INVENTORY POINT: ",PRC("SITE"),"-",PRCP("IN")
|
|
W !,"REF #",?8,"DT",?13,"STA-FCP-2237",?27,"TRANSID",?37," CC/SA",?54,"QTY",?63,"INV $",?73,"SELL $"
|
|
S %="",$P(%,"-",81)="" W !,%
|
|
Q
|