| [613] | 1 | PRCPRVS0 ;WISC/RFJ-voucher summary (continued) ;15 Jun 92
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | PRINT ; print report
|
|---|
| 8 | 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
|
|---|
| 9 | S Y=DATESTRT D DD^%DT S MONTH=Y
|
|---|
| 10 | S SCREEN=$$SCRPAUSE^PRCPUREP,PAGE=1 D NOW^%DTC S Y=% D DD^%DT S NOW=Y U IO
|
|---|
| 11 | S (TSUPISS,TSUPISSA,TSUPOTH,TSUPREC,TSUPRECA,ACCT,ACCTBAL,OPENBAL)=""
|
|---|
| 12 | F S ACCT=$O(OPEN(ACCT)) Q:'ACCT!($G(PRCPFLAG)) D H D
|
|---|
| 13 | . S (TACCISS,TACCISSA,TACCOTH,TACCREC,TACCRECA)=""
|
|---|
| 14 | . S $P(OPENBAL,"^")=$P(OPENBAL,"^")+$P(OPEN(ACCT),"^"),$P(OPENBAL,"^",2)=$P(OPENBAL,"^",2)+$P(OPEN(ACCT),"^",2)
|
|---|
| 15 | . 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
|
|---|
| 16 | . . S TRANSID=0 F S TRANSID=$O(^TMP($J,"PRCPRVSR",ACCT,REFNO,DATE,TRANSID)) Q:(TRANSID)=""!($G(PRCPFLAG)) S D=^(TRANSID) D
|
|---|
| 17 | . . . S CC=$E($P(D,"^",3),1,4) I CC'="" S CC=CC_"/"_$P(D,"^",4)
|
|---|
| 18 | . . . 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))
|
|---|
| 19 | . . . S TRANSNO=$P(D,"^") I TRANSNO="OTHER" D SETVAR("TACCOTH")
|
|---|
| 20 | . . . ; set totals for receipts
|
|---|
| 21 | . . . I +TRANSNO,$P(TRANSNO,"-",2)="" D
|
|---|
| 22 | . . . . I $E($P(D,"^",2))="R" D SETVAR("TACCREC") Q
|
|---|
| 23 | . . . . D SETVAR("TACCRECA")
|
|---|
| 24 | . . . ; set totals for issues
|
|---|
| 25 | . . . I +TRANSNO,$P(TRANSNO,"-",2)'="" D
|
|---|
| 26 | . . . . I $E($P(D,"^",2))="R" D SETVAR("TACCISS") Q
|
|---|
| 27 | . . . . D SETVAR("TACCISSA")
|
|---|
| 28 | . . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 29 | . . I '$G(PRCPFLAG),$Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 30 | . . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
|
|---|
| 31 | . I $G(PRCPFLAG) Q
|
|---|
| 32 | . I $Y>(IOSL-11) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 33 | . W !!?4,"TOTAL ACCT CODE ISSUES:",?49,$$SHOWTOTL("TACCISS")
|
|---|
| 34 | . W !?4,"TOTAL ACCT CODE ISSUE ADJ:",?49,$$SHOWTOTL("TACCISSA")
|
|---|
| 35 | . W !?4,"TOTAL ACCT CODE RECEIPTS:",?49,$$SHOWTOTL("TACCREC")
|
|---|
| 36 | . W !?4,"TOTAL ACCT CODE RECEIPT ADJ:",?49,$$SHOWTOTL("TACCRECA")
|
|---|
| 37 | . W !?4,"TOTAL ACCT CODE OTHER ADJ:",?49,$$SHOWTOTL("TACCOTH")
|
|---|
| 38 | . 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)
|
|---|
| 39 | . W !!?4,"OPEN BALANCE FOR ACCT CODE '",ACCT,"':",?49,$J($FN($P($G(OPEN(ACCT)),"^"),"T+"),9),$$SHOWVALU($P($G(OPEN(ACCT)),"^",2))
|
|---|
| 40 | . W !?4,"TOTALS FOR ACCT CODE '",ACCT,"':",?49,$$SHOWTOTL("TACCT")
|
|---|
| 41 | . S %="",$P(%,"^")=$P($G(OPEN(ACCT)),"^")+$P(TACCT,"^"),$P(%,"^",2)=$P($G(OPEN(ACCT)),"^",2)+$P(TACCT,"^",2)
|
|---|
| 42 | . S $P(ACCTBAL,"^")=$P(ACCTBAL,"^")+$P(%,"^"),$P(ACCTBAL,"^",2)=$P(ACCTBAL,"^",2)+$P(%,"^",2)
|
|---|
| 43 | . W !?4,"CLOSING BALANCE FOR ACCT CODE '",ACCT,"':",?49,$J($FN($P(%,"^"),"T+"),9),$$SHOWVALU($P(%,"^",2))
|
|---|
| 44 | . I $O(^TMP($J,"PRCPRVSR",ACCT)) D:SCREEN P^PRCPUREP
|
|---|
| 45 | I $G(PRCPFLAG) D Q Q
|
|---|
| 46 | I $Y>(IOSL-12) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) S ACCT="END OF REPORT" D H
|
|---|
| 47 | W !!,"** TOTAL SUPPLY ISSUES:",?49,$$SHOWTOTL("TSUPISS")
|
|---|
| 48 | W !,"** TOTAL SUPPLY ISSUE ADJ:",?49,$$SHOWTOTL("TSUPISSA")
|
|---|
| 49 | W !,"** TOTAL SUPPLY RECEIPTS:",?49,$$SHOWTOTL("TSUPREC")
|
|---|
| 50 | W !,"** TOTAL SUPPLY RECEIPT ADJ:",?49,$$SHOWTOTL("TSUPRECA")
|
|---|
| 51 | W !,"** TOTAL OTHER ADJ:",?49,$$SHOWTOTL("TSUPOTH")
|
|---|
| 52 | S TACCT="" F %="TSUPISS","TSUPISSA","TSUPOTH","TSUPREC","TSUPRECA" F P=1:1:3 S $P(TACCT,"^",P)=$P(TACCT,"^",P)+$P(@%,"^",P)
|
|---|
| 53 | W !!,"** TOTALS FOR SUPPLY:",?49,$$SHOWTOTL("TACCT")
|
|---|
| 54 | W !!,"** OPENING BALANCE FOR SUPPLY:",?49,$J($FN($P(OPENBAL,"^"),"T+"),9),$$SHOWVALU($P(OPENBAL,"^",2))
|
|---|
| 55 | W !,"** CLOSING BALANCE FOR SUPPLY:",?49,$J($FN($P(ACCTBAL,"^"),"T+"),9),$$SHOWVALU($P(ACCTBAL,"^",2))
|
|---|
| 56 | D END^PRCPUREP
|
|---|
| 57 | Q D ^%ZISC K ^TMP($J,"PRCPRVSR") Q
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | SETVAR(V1) ;set total variable v1
|
|---|
| 61 | F %=1:1:3 S $P(@V1,"^",%)=$P(@V1,"^",%)+$P(D,"^",%+4)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | ;
|
|---|
| 65 | SHOWTOTL(V1) ;print totals for variable v1
|
|---|
| 66 | Q $J($FN($P(@V1,"^"),"T+"),9)_$$SHOWVALU($P(@V1,"^",2))_$$SHOWVALU($P(@V1,"^",3))
|
|---|
| 67 | ;
|
|---|
| 68 | ;
|
|---|
| 69 | SHOWVALU(V1) ;show value
|
|---|
| 70 | N % S %="+" S:+V1=0 %=" " I V1<0 S V1=-V1,%="-"
|
|---|
| 71 | Q $J(V1,10,2)_%
|
|---|
| 72 | ;
|
|---|
| 73 | ;
|
|---|
| 74 | H ;heading
|
|---|
| 75 | S %=NOW_" PAGE: "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|---|
| 76 | W $C(13),"VOUCHER SUMMARY REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
|
|---|
| 77 | W !?5,"TRANSACTIONS FOR THE MONTH-YEAR: ",MONTH
|
|---|
| 78 | W !?4,"ACCOUNT CODE: ",ACCT,?30,"STA-INVENTORY POINT: ",PRC("SITE"),"-",PRCP("IN")
|
|---|
| 79 | W !,"REF #",?8,"DT",?13,"STA-FCP-2237",?27,"TRANSID",?37," CC/SA",?54,"QTY",?63,"INV $",?73,"SELL $"
|
|---|
| 80 | S %="",$P(%,"-",81)="" W !,%
|
|---|
| 81 | Q
|
|---|
