FHPRR1 ; HISC/REL/RVD - Projected Usage ;3/6/95 16:07
;;5.5;DIETETICS;;Jan 28, 2005
S FHP=$O(^FH(119.71,0)) I FHP'<1,$O(^FH(119.71,FHP))<1 G P1
P0 R !!,"Select PRODUCTION FACILITY: ",X:DTIME G:'$T!("^"[X) KIL
K DIC S DIC="^FH(119.71,",DIC(0)="EMQ" D ^DIC G:Y<1 P0 S FHP=+Y
P1 D DT G:"^"[X KIL
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
R0 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
S V0=V0?1"Y".E
W !!,"The report requires a 132 column compressed printer.",!
W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="Q1^FHPRR1",FHLST="FHP^SDT^EDT^V0^M(" D EN2^FH G KIL
U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
Q1 ; Print Projected Usage
K ^TMP($J) F DOW=1:1:7 F K3=1:1:3 D FOR
G ^FHPRR2
C0 I $G(^FH(119.72,P0,"I"))="Y" Q
W !!?5,"Service Point: ",$P(^FH(119.72,P0,0),"^",1)
C1 W !?5,"Average Census: " R X:DTIME I '$T!(X["^") S X="^" Q
I X'?1N.N!(X>9999) W *7," Must be a number less than 9999" G C1
S M(P0)=X Q
FOR F P0=0:0 S P0=$O(M(P0)) Q:P0<1 D F1
Q
F1 S S1=M(P0),N0=$P(^FH(119.72,P0,0),"^",2)
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
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
Q
F2 S Y=$J(S0*S1/100,0,0) Q:Y<1
S X=^FH(116.2,LL,0),C0=$P(X,"^",2)
F3 S:'$D(^TMP($J,"P",DOW_K3,P0,C0,N0)) ^TMP($J,"P",DOW_K3,P0,C0,N0)=0 S ^(N0)=^(N0)+Y
S:'$D(^TMP($J,"M",DOW_K3,C0,N0)) ^TMP($J,"M",DOW_K3,C0,N0)=0 S ^(N0)=^(N0)+Y Q
DT ; Get From/To Dates
D1 S %DT="AEX",%DT("A")="Starting Date: " W ! D ^%DT Q:U[X!$D(DTOUT) G:Y<1 D1 S SDT=+Y
D2 S %DT="AEFX",%DT("A")=" Ending Date: " D ^%DT Q:U[X!$D(DTOUT) G:Y<1 D2 S EDT=+Y
I EDT<SDT W *7," [End before Start?] " G D1
Q
KIL K ^TMP($J) G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRR1 1982 printed Nov 22, 2024@17:04:52 Page 2
FHPRR1 ; HISC/REL/RVD - Projected Usage ;3/6/95 16:07
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 SET FHP=$ORDER(^FH(119.71,0))
IF FHP'<1
IF $ORDER(^FH(119.71,FHP))<1
GOTO P1
P0 READ !!,"Select PRODUCTION FACILITY: ",X:DTIME
if '$TEST!("^"[X)
GOTO KIL
+1 KILL DIC
SET DIC="^FH(119.71,"
SET DIC(0)="EMQ"
DO ^DIC
if Y<1
GOTO P0
SET FHP=+Y
P1 DO DT
if "^"[X
GOTO KIL
+1 KILL M
FOR P0=0:0
SET P0=$ORDER(^FH(119.72,P0))
if P0<1
QUIT
IF $PIECE($GET(^(P0,0)),"^",3)=FHP
DO C0
if X="^"
GOTO KIL
R0 READ !!,"Sort by Vendor Y// ",V0:DTIME
if '$TEST!(V0="^")
GOTO KIL
if V0=""
SET V0="Y"
SET X=V0
DO TR^FH
SET V0=X
IF $PIECE("YES",V0,1)'=""
IF $PIECE("NO",V0,1)'=""
WRITE *7," Answer YES or NO"
GOTO R0
+1 SET V0=V0?1"Y".E
+2 WRITE !!,"The report requires a 132 column compressed printer.",!
+3 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select LIST Printer: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+4 IF $DATA(IO("Q"))
SET FHPGM="Q1^FHPRR1"
SET FHLST="FHP^SDT^EDT^V0^M("
DO EN2^FH
GOTO KIL
+5 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO KIL
Q1 ; Print Projected Usage
+1 KILL ^TMP($JOB)
FOR DOW=1:1:7
FOR K3=1:1:3
DO FOR
+2 GOTO ^FHPRR2
C0 IF $GET(^FH(119.72,P0,"I"))="Y"
QUIT
+1 WRITE !!?5,"Service Point: ",$PIECE(^FH(119.72,P0,0),"^",1)
C1 WRITE !?5,"Average Census: "
READ X:DTIME
IF '$TEST!(X["^")
SET X="^"
QUIT
+1 IF X'?1N.N!(X>9999)
WRITE *7," Must be a number less than 9999"
GOTO C1
+2 SET M(P0)=X
QUIT
FOR FOR P0=0:0
SET P0=$ORDER(M(P0))
if P0<1
QUIT
DO F1
+1 QUIT
F1 SET S1=M(P0)
SET N0=$PIECE(^FH(119.72,P0,0),"^",2)
+1 FOR LL=0:0
SET LL=$ORDER(^FH(119.72,P0,"A",LL))
if LL<1
QUIT
SET S0=$PIECE(^(LL,0),"^",DOW+1)
DO F2
+2 FOR LL=0:0
SET LL=$ORDER(^FH(119.72,P0,"B",LL))
if LL<1
QUIT
SET Y=$PIECE(^(LL,0),"^",3*DOW-2+K3)
IF Y>0
SET C0=$PIECE(^FH(116.2,LL,0),"^",2)
DO F3
+3 QUIT
F2 SET Y=$JUSTIFY(S0*S1/100,0,0)
if Y<1
QUIT
+1 SET X=^FH(116.2,LL,0)
SET C0=$PIECE(X,"^",2)
F3 if '$DATA(^TMP($JOB,"P",DOW_K3,P0,C0,N0))
SET ^TMP($JOB,"P",DOW_K3,P0,C0,N0)=0
SET ^(N0)=^(N0)+Y
+1 if '$DATA(^TMP($JOB,"M",DOW_K3,C0,N0))
SET ^TMP($JOB,"M",DOW_K3,C0,N0)=0
SET ^(N0)=^(N0)+Y
QUIT
DT ; Get From/To Dates
D1 SET %DT="AEX"
SET %DT("A")="Starting Date: "
WRITE !
DO ^%DT
if U[X!$DATA(DTOUT)
QUIT
if Y<1
GOTO D1
SET SDT=+Y
D2 SET %DT="AEFX"
SET %DT("A")=" Ending Date: "
DO ^%DT
if U[X!$DATA(DTOUT)
QUIT
if Y<1
GOTO D2
SET EDT=+Y
+1 IF EDT<SDT
WRITE *7," [End before Start?] "
GOTO D1
+2 QUIT
KIL KILL ^TMP($JOB)
GOTO KILL^XUSCLEAN
