- FHPRF2 ; HISC/REL - Print Diet Percentages ;4/27/93 13:41
- ;;5.5;DIETETICS;;Jan 28, 2005
- S FHP=$O(^FH(119.72,0)) I FHP'<1,$O(^FH(119.72,FHP))<1 S FHP=0 G R1
- R0 R !!,"Select SERVICE POINT (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S FHP=0
- E K DIC S DIC="^FH(119.72,",DIC(0)="EMQ" D ^DIC G:Y<1 R0 S FHP=+Y
- R1 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^FHPRF2",FHLST="FHP" D EN2^FH G KIL
- U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
- Q1 ; Print Production Diet Percentage
- D NOW^%DTC S DTP=% D DTP^FH S PG=0
- I FHP S P0=FHP D Q2 Q
- F P0=0:0 S P0=$O(^FH(119.72,P0)) Q:P0<1 D Q2
- Q
- Q2 ;
- I $G(^FH(119.72,P0,"I"))="Y" Q
- W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !?13,"P R O D U C T I O N D I E T P E R C E N T A G E S"
- S X=$P(^FH(119.72,P0,0),"^",1) W !!?(79-$L(X)\2),X,!!?(79-$L(DTP)\2),DTP
- W !!?3,"Diet",?28,"Sun Mon Tue Wed Thu Fri Sat",!
- K S F L=1:1:7 S S(L)=0
- F P1=0:0 S P1=$O(^FH(116.2,"AP",P1)) Q:P1<1 F NX=0:0 S NX=$O(^FH(116.2,"AP",P1,NX)) Q:NX<1 I $D(^FH(119.72,P0,"A",NX)) S X=^(NX,0) D PR
- W !,"Not Eating",?23 F L=1:1:7 S Z=$S(S(L)<100:100-S(L),1:0),S(L)=S(L)+Z W $S('Z:$J("",8),1:$J(Z,8,1))
- W !!?3,"Total Sum",?23 F L=1:1:7 W $J(S(L),8,1)
- W ! Q
- PR S NAM=$P(^FH(116.2,NX,0),"^",1) W !,$E(NAM,1,23),?23
- F L=1:1:7 S Z=$P(X,"^",L+1),S(L)=S(L)+Z W $S('Z:$J("",8),1:$J(Z,8,1))
- Q
- KIL G KILL^XUSCLEAN
- FHPRF2 ; HISC/REL - Print Diet Percentages ;4/27/93 13:41
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 SET FHP=$ORDER(^FH(119.72,0))
- IF FHP'<1
- IF $ORDER(^FH(119.72,FHP))<1
- SET FHP=0
- GOTO R1
- R0 READ !!,"Select SERVICE POINT (or ALL): ",X:DTIME
- IF '$TEST!("^"[X)
- GOTO KIL
- IF X="all"
- DO TR^FH
- IF X="ALL"
- SET FHP=0
- +1 IF '$TEST
- KILL DIC
- SET DIC="^FH(119.72,"
- SET DIC(0)="EMQ"
- DO ^DIC
- IF Y<1
- GOTO R0
- SET FHP=+Y
- R1 WRITE !
- KILL IOP,%ZIS
- SET %ZIS("A")="Select LIST Printer: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- IF POP
- GOTO KIL
- +1 IF $DATA(IO("Q"))
- SET FHPGM="Q1^FHPRF2"
- SET FHLST="FHP"
- DO EN2^FH
- GOTO KIL
- +2 USE IO
- DO Q1
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- Q1 ; Print Production Diet Percentage
- +1 DO NOW^%DTC
- SET DTP=%
- DO DTP^FH
- SET PG=0
- +2 IF FHP
- SET P0=FHP
- DO Q2
- QUIT
- +3 FOR P0=0:0
- SET P0=$ORDER(^FH(119.72,P0))
- IF P0<1
- QUIT
- DO Q2
- +4 QUIT
- Q2 ;
- +1 IF $GET(^FH(119.72,P0,"I"))="Y"
- QUIT
- +2 IF '($EXTRACT(IOST,1,2)'="C-"&'PG)
- WRITE @IOF
- SET PG=PG+1
- WRITE !?13,"P R O D U C T I O N D I E T P E R C E N T A G E S"
- +3 SET X=$PIECE(^FH(119.72,P0,0),"^",1)
- WRITE !!?(79-$LENGTH(X)\2),X,!!?(79-$LENGTH(DTP)\2),DTP
- +4 WRITE !!?3,"Diet",?28,"Sun Mon Tue Wed Thu Fri Sat",!
- +5 KILL S
- FOR L=1:1:7
- SET S(L)=0
- +6 FOR P1=0:0
- SET P1=$ORDER(^FH(116.2,"AP",P1))
- IF P1<1
- QUIT
- FOR NX=0:0
- SET NX=$ORDER(^FH(116.2,"AP",P1,NX))
- IF NX<1
- QUIT
- IF $DATA(^FH(119.72,P0,"A",NX))
- SET X=^(NX,0)
- DO PR
- +7 WRITE !,"Not Eating",?23
- FOR L=1:1:7
- SET Z=$SELECT(S(L)<100:100-S(L),1:0)
- SET S(L)=S(L)+Z
- WRITE $SELECT('Z:$JUSTIFY("",8),1:$JUSTIFY(Z,8,1))
- +8 WRITE !!?3,"Total Sum",?23
- FOR L=1:1:7
- WRITE $JUSTIFY(S(L),8,1)
- +9 WRITE !
- QUIT
- PR SET NAM=$PIECE(^FH(116.2,NX,0),"^",1)
- WRITE !,$EXTRACT(NAM,1,23),?23
- +1 FOR L=1:1:7
- SET Z=$PIECE(X,"^",L+1)
- SET S(L)=S(L)+Z
- WRITE $SELECT('Z:$JUSTIFY("",8),1:$JUSTIFY(Z,8,1))
- +2 QUIT
- KIL GOTO KILL^XUSCLEAN
