FHPRF2.m

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