source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRPT3.m@ 810

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1PRCHRPT3 ;BOISE/TKW-SUPPLEMENT TO PRCHRPT2--ACTUAL PRINT OF FPDS REPORTS ;8JUL1986/7:20 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN S PRCHPAGE=0,PRCHDY=99 S ^TMP($J,"TOTAL")="** REPORT TOTAL **"
5 I PRCHRPT=1 S N="BREAKOUT CODE",PRCHRFLG="B",PRCHKEY=-1 D RD1 S X=^TMP($J,"TOTAL") D PRTT
6 I PRCHRPT=1 S N="TYPE CODE",PRCHRFLG="T",PRCHPAGE=0,PRCHDY=99,PRCHKEY=-1,^TMP($J,"TOTAL")="** REPORT TOTAL **" D RD1 S X=^TMP($J,"TOTAL") D PRTT Q
7 I PRCHRPT=2 S N="P.O.NUMBER",PRCHPONO=-1 D RD2 S X=^TMP($J,"TOTAL") D PRTT Q
8 I PRCHRPT=3 S N="CONTRACT NO.",PRCHRFLG="C",PRCHKEY=-1 D RD1 S X=^TMP($J,"TOTAL") D PRTT Q
9 I PRCHRPT=4 S N="",X=^TMP($J),PRCHKEY="" D PRT1 Q
10 I PRCHRPT=5 S N="FUND CONTROL POINT",PRCHRFLG="F",PRCHKEY=-1 S (PRCHOTCT,PRCHLTOT,PRCHTTOT)=0 D
11 . D RD1
12 . W !?30,"----------",?45,"---------",?65,"------------"
13 . W !?15,"TOTALS",?35,PRCHOTCT,?50,PRCHLTOT,?68,PRCHTTOT
14 . K PRCHOTCT,PRCHLTOT,PRCHTTOT Q
15 Q
16RD1 ; READ REPORT FILE ^TMP AND PRINT REPORT
17 S PRCHKEY=$O(^TMP($J,"R",PRCHRFLG,PRCHKEY)) Q:PRCHKEY="" S X=^(PRCHKEY) D D PRT1
18 . S PRCHOTCT=PRCHOTCT+$P(X,U,2)
19 . S PRCHLTOT=PRCHLTOT+$P(X,U,3)
20 . S PRCHTTOT=PRCHTTOT+$P(X,U,4)
21 S $P(^TMP($J,"TOTAL"),U,2)=$P(^TMP($J,"TOTAL"),U,2)+$P(X,U,2),$P(^("TOTAL"),U,3)=$P(^("TOTAL"),U,3)+$P(X,U,3),$P(^("TOTAL"),U,4)=$P(^("TOTAL"),U,4)+$P(X,U,4)
22 G RD1
23RD2 ; READ ^TMP FILE FOR REPORT BY P.O.NUMBER
24 S PRCHPONO=$O(^TMP($J,"R",PRCHPONO)) Q:'PRCHPONO S X=^(PRCHPONO) D PRT2
25 S $P(^TMP($J,"TOTAL"),U,2)=$P(^TMP($J,"TOTAL"),U,2)+1,$P(^("TOTAL"),U,3)=$P(^("TOTAL"),U,3)+$P(X,U,2)
26 S I=0,PRCHTOT=0 F K=1:1 S I=$O(^TMP($J,"R",PRCHPONO,"C",I)) Q:I="" S X=^(I),PRCHTOT=PRCHTOT+$P(X,U,2) D PRT3 S $P(^("TOTAL"),U,4)=$P(^TMP($J,"TOTAL"),U,4)+$P(X,U,2)
27 I K>2 D:PRCHDY>(IOSL-4) HDR W ?57,"*TOTAL*",?66,$J(PRCHTOT,11,2),! S PRCHDY=PRCHDY+1
28 W ! S PRCHDY=PRCHDY+1 G RD2
29PRT1 D:PRCHDY>(IOSL-6) HDR W PRCHKEY,?3,$P(X,U,1) I $L($P(X,U,1))>27 W ! S PRCHDY=PRCHDY+1
30 W ?30,$J($P(X,U,2),8),?45,$J($P(X,U,3),8),?66,$J($P(X,U,4),11,2),!! S PRCHDY=PRCHDY+2 Q
31PRT2 D:PRCHDY>(IOSL-6) HDR W $P(PRCHPONO,"-",2),?12,"P.O.DATE:",$P(X,U,1),?45,$J($P(X,U,2),8),! S PRCHDY=PRCHDY+1 Q
32PRT3 D:PRCHDY>(IOSL-4) HDR W:K=1 ?18,"CONTRACTS:" W ?30,I
33 W ?66,$J($P(X,U,2),11,2),! S PRCHDY=PRCHDY+1 Q
34PRTT ; PRINT REPORT GRAND TOTALS
35 D:PRCHDY>(IOSL-7) HDR W !!!,?8,$P(X,U,1)
36 W ?30,$J($P(X,U,2),8),?45,$J($P(X,U,3),8),?66,$J($P(X,U,4),11,2),! Q
37HDR S PRCHPAGE=PRCHPAGE+1 W @IOF,"PROCUREMENT & ACCOUNTING TRANSACTIONS STATISTICS",?51,PRCHPDAT,?74,"PAGE ",PRCHPAGE,!
38 W "CONTROL POINTS/MONTH FOR STATION: ",PRC("SITE")
39 W " P.O.DATES "_PRCHPFR_" - "_PRCHPTO,!!
40 W ?45,"LINE/ITEM",!,N,?30,"P.O.COUNT",?47,"TOTAL",?65,"TOTAL AMOUNT",!
41 F J=0:1:(IOM-2) W "-"
42 W !! S PRCHDY=6 Q
43DEL2237 ; The option Delete 2237 Request from Worksheet file is being de-
44 ; activated. It is no longer needed, as the 2237s with status of
45 ; Returned to Service by PPM or by P&C no longer appear on the
46 ; Outstanding 2237 Report. This Delete option was removing the
47 ; 2237 from file 443,but leaving the approving e-sig info in file
48 ; file 410, making inaccessable to A&MM and to the service.
49 W !!,"This option has been de-activated, as it is no longer needed."
50 W !,"Instead of deleting the 2237, return it to the service. 2237s"
51 W !,"returned to the service no longer appear on the Outstanding 2237"
52 W !,"Report."
53 Q
Note: See TracBrowser for help on using the repository browser.