source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRPTA.m@ 623

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PRCHRPTA ;WISC/TKW-PUBLIC LAW 100-322 REPORT--CONTINUED ;4/13/93 11:15
2V ;;5.1;IFCAP;*89*;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN S (PRCHTOT,PRCHTOTD)=0 D RD1 W $C(13) Q ;W ?132,"___________",!!,?120,"**TOTAL**",?132,$J(PRCHTOT,11,2),!,$C(13)
6 Q
7 ;
8RD1 ;PRINT DETAILED REPORT
9 S PRCHFSC="" F J=1:1 S PRCHFSC=$O(^TMP($J,"R",PRCHFSC)) G:PRCHFSC="" Q D:PRCHDY>55 HDR S PRCHDY=PRCHDY+1 D RD2
10 Q
11 ;
12RD2 S PRCHDESC=0 F S PRCHDESC=$O(^TMP($J,"R",PRCHFSC,PRCHDESC)) Q:PRCHDESC="" D RD3
13 Q
14 ;
15RD3 S (PRCHV,L)="" F S PRCHV=$O(^TMP($J,"R",PRCHFSC,PRCHDESC,PRCHV)) Q:PRCHV="" F S L=$O(^TMP($J,"R",PRCHFSC,PRCHDESC,PRCHV,L)) Q:L="" S PRCHSRC="" D
16 . F S PRCHSRC=$O(^TMP($J,"R",PRCHFSC,PRCHDESC,PRCHV,L,PRCHSRC)) Q:PRCHSRC="" S X=^(PRCHSRC) I "2B"[$P(X,U,9) S AVRG=$S($P(X,U,4)'=0:($P(X,U,6))/($P(X,U,4)),1:0) S PRCHTOTD=PRCHTOTD+$P(X,U,6) D PRT
17 Q
18 ;
19PRT D:PRCHDY>60 HDR W PRCHDESC,?32,$J($P(X,U,12),5),?39,PRCHFSC,?46,$S($P(X,U,2)'=0:$P(X,U,2),1:"-"),?61,$J($FN($P(X,U,4),","),7),?73,$S(PRCHV'=0:PRCHV,1:"-")
20 W ?77,$J($P(X,U,6),11,2),?90,$J($P(X,U,10),9,2),?101,$J($P(X,U,11),9,2),?112,$J(AVRG,9,2),!
21 S PRCHTOT=PRCHTOT+$P(X,U,6),PRCHDY=PRCHDY+1
22 Q
23 ;
24HDR S PRCHPAGE=PRCHPAGE+1 W @IOF,?55,"P.L. 100-322 Local Procurement",!,?56,"Aggregated Item Detail Report",!,?108,$P(PRCHPDAT,"@"),?122,"PAGE ",PRCHPAGE,!
25 W ?4,"STATION: "_PRC("SITE")_"-"_PRCHSITE,!,"Dates Received: "_PRCHFT_" FSC CODES: " F I=0:0 S I=$O(^TMP($J,"FSCG",I)) Q:'I W I_" "
26 W " Non-Expendable Purchases NOT Included",!
27 W ?33,"ITEM",?63,"TOTAL",?82,"TOTAL",?96,"LOW",?106,"HIGH",?115,"AVERAGE",!
28 W "DESCRIPTION",?32,"NUMBER",?40,"FSC",?48,"N.I.I.N",?62,"QUANTITY",?72,"UNIT",?81,"DOLLARS",?95,"COST",?106,"COST",?116,"COST",!
29 F I=0:1:(IOM-2) W "-"
30 W !! S PRCHDY=7
31 Q
32 ;
33EN2 ;PRINT SUMMARY TOTALS
34 D HDR2,RDS
35 Q
36 ;
37RDS S (PRCHFSCG,PRCHGT,PRCHT)="" F PRCHFSC=0:0 S PRCHFSC=$O(^TMP($J,"FSC",PRCHFSC)) Q:'PRCHFSC D:$E(PRCHFSC,1,2)'=PRCHFSCG GT S X=^TMP($J,"FSC",PRCHFSC) D ACM W PRCHFSC_" "_$P(^TMP($J,"FSC",PRCHFSC),U,1) D PRT2
38 S:PRCHFSCG]"" PRCHFSCG="END" D GT,T
39 Q
40 ;
41PRT2 S PRCHTOT=+$P(X,U,2)
42 W ?41,$J(PRCHTOT,11,2) I PRCHTOT W ?60,$J($P(X,U,3),11,2),?79,$J((($P(X,U,3)/PRCHTOT)*100),6,2),?91,$J($P(X,U,4),11,2),?110,$J((($P(X,U,4)/PRCHTOT)*100),6,2),?122,$J($P(X,U,5),11,2),?141,$J((($P(X,U,5)/PRCHTOT)*100),6,2)
43 W ! S PRCHDY=PRCHDY+1
44 Q
45 ;
46GT ;PRINT GROUP SUB-TOTALS
47 D:PRCHDY>55 HDR2 I PRCHFSCG="" G GT1
48 W ?2,"SUB-TOTAL" S X=PRCHGT D PRT2 Q:PRCHFSCG="END"
49 ;
50GT1 S PRCHGT="",PRCHFSCG=$E(PRCHFSC,1,2)
51 W !,?2,"FSC GROUP: "_$S($D(^TMP($J,"FSCG",PRCHFSCG)):^(PRCHFSCG),1:"**INVALID**"),! S PRCHDY=PRCHDY+2
52 Q
53 ;
54ACM F I=2:1:5 S $P(PRCHGT,U,I)=$P(PRCHGT,U,I)+$P(X,U,I),$P(PRCHT,U,I)=$P(PRCHT,U,I)+$P(X,U,I)
55 Q
56 ;
57T S I="___________" W ?41,I,?60,I,?79,$E(I,1,6),?91,I,?110,$E(I,1,6),?122,I,?141,$E(I,1,6),!
58 S PRCHDY=PRCHDY+1,X=PRCHT W ?1,"* TOTAL *" D PRT2
59 Q
60 ;
61HDR2 S PRCHPAGE=PRCHPAGE+1 W @IOF,?55,"P.L. 100-322 SUMMARY TOTALS REPORT",?108,$P(PRCHPDAT,"@"),?122,"PAGE ",PRCHPAGE,!
62 W ?4,"STATION: "_PRC("SITE")_"-"_PRCHSITE,!,"Dates Received: "_PRCHFT_" FSC CODES: " F I=0:0 S I=$O(^TMP($J,"FSCG",I)) Q:'I W I_" "
63 W " Non-Expendable Purchases NOT Included",!!
64 W ?63,"ALL OPEN",?81,"% OF",?94,"OPEN MKT",?112,"% OF",?123,"OPEN MARKET",?143,"% OF",!
65 W "FSC",?47,"TOTAL",?65,"MARKET",?80,"TOTAL",?93,"EMERGENCY",?111,"TOTAL",?120,"LESS EMERGENCY",?142,"TOTAL",!
66 F J=0:1:(IOM-2) W "-"
67 W !! S PRCHDY=8
68 Q
69 ;
70NONE ; perform this if no records were gathered
71 D HDR
72 W !,"No records matched the selected criteria.",!
73 Q
74 ;
75Q D:PRCHDY>55 HDR S PRCHDY=PRCHDY+1 W ?77,"___________",!," * TOTAL *",?80,PRCHTOTD
76 Q
Note: See TracBrowser for help on using the repository browser.