- 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
- 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
