source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRVS0.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1PRCPRVS0 ;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 ;
7PRINT ; 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
57Q D ^%ZISC K ^TMP($J,"PRCPRVSR") Q
58 ;
59 ;
60SETVAR(V1) ;set total variable v1
61 F %=1:1:3 S $P(@V1,"^",%)=$P(@V1,"^",%)+$P(D,"^",%+4)
62 Q
63 ;
64 ;
65SHOWTOTL(V1) ;print totals for variable v1
66 Q $J($FN($P(@V1,"^"),"T+"),9)_$$SHOWVALU($P(@V1,"^",2))_$$SHOWVALU($P(@V1,"^",3))
67 ;
68 ;
69SHOWVALU(V1) ;show value
70 N % S %="+" S:+V1=0 %=" " I V1<0 S V1=-V1,%="-"
71 Q $J(V1,10,2)_%
72 ;
73 ;
74H ;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
Note: See TracBrowser for help on using the repository browser.