source: FOIAVistA/trunk/r/DIETETICS-FH/FHPRR1.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1FHPRR1 ; HISC/REL/RVD - Projected Usage ;3/6/95 16:07
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 S FHP=$O(^FH(119.71,0)) I FHP'<1,$O(^FH(119.71,FHP))<1 G P1
4P0 R !!,"Select PRODUCTION FACILITY: ",X:DTIME G:'$T!("^"[X) KIL
5 K DIC S DIC="^FH(119.71,",DIC(0)="EMQ" D ^DIC G:Y<1 P0 S FHP=+Y
6P1 D DT G:"^"[X KIL
7 K M F P0=0:0 S P0=$O(^FH(119.72,P0)) Q:P0<1 I $P($G(^(P0,0)),"^",3)=FHP D C0 G:X="^" KIL
8R0 R !!,"Sort by Vendor Y// ",V0:DTIME G:'$T!(V0="^") KIL S:V0="" V0="Y" S X=V0 D TR^FH S V0=X I $P("YES",V0,1)'="",$P("NO",V0,1)'="" W *7," Answer YES or NO" G R0
9 S V0=V0?1"Y".E
10 W !!,"The report requires a 132 column compressed printer.",!
11 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
12 I $D(IO("Q")) S FHPGM="Q1^FHPRR1",FHLST="FHP^SDT^EDT^V0^M(" D EN2^FH G KIL
13 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
14Q1 ; Print Projected Usage
15 K ^TMP($J) F DOW=1:1:7 F K3=1:1:3 D FOR
16 G ^FHPRR2
17C0 I $G(^FH(119.72,P0,"I"))="Y" Q
18 W !!?5,"Service Point: ",$P(^FH(119.72,P0,0),"^",1)
19C1 W !?5,"Average Census: " R X:DTIME I '$T!(X["^") S X="^" Q
20 I X'?1N.N!(X>9999) W *7," Must be a number less than 9999" G C1
21 S M(P0)=X Q
22FOR F P0=0:0 S P0=$O(M(P0)) Q:P0<1 D F1
23 Q
24F1 S S1=M(P0),N0=$P(^FH(119.72,P0,0),"^",2)
25 F LL=0:0 S LL=$O(^FH(119.72,P0,"A",LL)) Q:LL<1 S S0=$P(^(LL,0),"^",DOW+1) D F2
26 F LL=0:0 S LL=$O(^FH(119.72,P0,"B",LL)) Q:LL<1 S Y=$P(^(LL,0),"^",3*DOW-2+K3) I Y>0 S C0=$P(^FH(116.2,LL,0),"^",2) D F3
27 Q
28F2 S Y=$J(S0*S1/100,0,0) Q:Y<1
29 S X=^FH(116.2,LL,0),C0=$P(X,"^",2)
30F3 S:'$D(^TMP($J,"P",DOW_K3,P0,C0,N0)) ^TMP($J,"P",DOW_K3,P0,C0,N0)=0 S ^(N0)=^(N0)+Y
31 S:'$D(^TMP($J,"M",DOW_K3,C0,N0)) ^TMP($J,"M",DOW_K3,C0,N0)=0 S ^(N0)=^(N0)+Y Q
32DT ; Get From/To Dates
33D1 S %DT="AEX",%DT("A")="Starting Date: " W ! D ^%DT Q:U[X!$D(DTOUT) G:Y<1 D1 S SDT=+Y
34D2 S %DT="AEFX",%DT("A")=" Ending Date: " D ^%DT Q:U[X!$D(DTOUT) G:Y<1 D2 S EDT=+Y
35 I EDT<SDT W *7," [End before Start?] " G D1
36 Q
37KIL K ^TMP($J) G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.