FHADR61.m

FHADR61 ; HISC/NCA - Nutritive Analysis Average ;12/29/93  13:54

 ;;5.5;DIETETICS;;Jan 28, 2005

EN1 ; Enter/Edit Nutritive Analysis Average of one wk reg menu

 D YR^FHADR1 G:'PRE KIL

 S OLD=$P($G(^FH(117.3,PRE,3)),"^",2),Y=OLD X ^DD("DD") S OLD=Y

D1 S %DT="AEPX",%DT("A")="Enter Date Nutritive Analysis was taken: " S:OLD'="" %DT("B")=OLD W ! D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,D1:Y<1 S SDT=+Y

 I SDT'<DT W *7,!?29,"  [Must Start before Today!] " G D1

 S YR=$E(SDT,1,3),S1=$E(SDT,4,5),QTR=$S(S1<4:2,S1<7:3,S1<10:4,1:1) S:QTR=1 YR=YR+1

 I YR'=$E(PRE,1,3) W *7,!?29,"  [Date Is Not Within the Fiscal Year!] " G D1

 S $P(^FH(117.3,PRE,3),"^",2)=SDT

 K DIC,DIE S DIE="^FH(117.3,",DA=PRE,DR="41:46"

 D ^DIE K DA,DIC,DIE,DR S OLD=PRE

SET ; Set all three quarters with the Nutritive Analysis Data

 F QTR=2:1:4 S PRE=$E(OLD,1,4)_QTR_"00",$P(^FH(117.3,PRE,3),"^",2,8)=$P($G(^FH(117.3,OLD,3)),"^",2,8)

KIL G KILL^XUSCLEAN

EN2 ; Print the Nutritive Analysis Average of one wk reg menu

 D HDR

 S PRE=FHYR_"0000",X1=""

 F L1=PRE:0 S L1=$O(^FH(117.3,L1)) Q:L1<1!($E(L1,1,3)'=$E(PRE,1,3))  S X=$P($G(^FH(117.3,L1,3)),"^",2,8) S:"^^^^^^"'[X X1=X

 I X1'="" D

 .S DTP=$P(X1,"^",1) D DTP^FH

 .W !?100,"Date Taken: ",DTP,!!

 .S TIT="Calories^%CHO^%PRO^%FAT^Mg CHOL^Mg Na"

 .W ?30 F L2=1:1:6 W $P(TIT,"^",L2)_":",$J($P(X1,"^",L2+1),5),"  "

 .Q

 Q

HDR ; Print Heading for Nutritive Analysis

 D:$Y'<(LIN-6) HDR^FHADRPT,HDR2^FHADR3A

 W !!!,"Nutritive Analysis 7 Days Average Regular Menu",!

 Q

FHADR61   ; HISC/NCA - Nutritive Analysis Average ;12/29/93  13:54

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

EN1       ; Enter/Edit Nutritive Analysis Average of one wk reg menu

 +1        DO YR^FHADR1

           IF 'PRE

               GOTO KIL

 +2        SET OLD=$PIECE($GET(^FH(117.3,PRE,3)),"^",2)

           SET Y=OLD

           XECUTE ^DD("DD")

           SET OLD=Y

D1         SET %DT="AEPX"

           SET %DT("A")="Enter Date Nutritive Analysis was taken: "

           IF OLD'=""

               SET %DT("B")=OLD

           WRITE !

           DO ^%DT

           IF $DATA(DTOUT)

               SET X="^"

           IF U[X

               GOTO KIL

           IF Y<1

               GOTO D1

           SET SDT=+Y

 +1        IF SDT'<DT

               WRITE *7,!?29,"  [Must Start before Today!] "

               GOTO D1

 +2        SET YR=$EXTRACT(SDT,1,3)

           SET S1=$EXTRACT(SDT,4,5)

           SET QTR=$SELECT(S1<4:2,S1<7:3,S1<10:4,1:1)

           IF QTR=1

               SET YR=YR+1

 +3        IF YR'=$EXTRACT(PRE,1,3)

               WRITE *7,!?29,"  [Date Is Not Within the Fiscal Year!] "

               GOTO D1

 +4        SET $PIECE(^FH(117.3,PRE,3),"^",2)=SDT

 +5        KILL DIC,DIE

           SET DIE="^FH(117.3,"

           SET DA=PRE

           SET DR="41:46"

 +6        DO ^DIE

           KILL DA,DIC,DIE,DR

           SET OLD=PRE

SET       ; Set all three quarters with the Nutritive Analysis Data

 +1        FOR QTR=2:1:4

               SET PRE=$EXTRACT(OLD,1,4)_QTR_"00"

               SET $PIECE(^FH(117.3,PRE,3),"^",2,8)=$PIECE($GET(^FH(117.3,OLD,3)),"^",2,8)

KIL        GOTO KILL^XUSCLEAN

EN2       ; Print the Nutritive Analysis Average of one wk reg menu

 +1        DO HDR

 +2        SET PRE=FHYR_"0000"

           SET X1=""

 +3        FOR L1=PRE:0

               SET L1=$ORDER(^FH(117.3,L1))

               IF L1<1!($EXTRACT(L1,1,3)'=$EXTRACT(PRE,1,3))

                   QUIT 

               SET X=$PIECE($GET(^FH(117.3,L1,3)),"^",2,8)

               IF "^^^^^^"'[X

                   SET X1=X

 +4        IF X1'=""

               Begin DoDot:1

 +5                SET DTP=$PIECE(X1,"^",1)

                   DO DTP^FH

 +6                WRITE !?100,"Date Taken: ",DTP,!!

 +7                SET TIT="Calories^%CHO^%PRO^%FAT^Mg CHOL^Mg Na"

 +8                WRITE ?30

                   FOR L2=1:1:6

                       WRITE $PIECE(TIT,"^",L2)_":",$JUSTIFY($PIECE(X1,"^",L2+1),5),"  "

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

HDR       ; Print Heading for Nutritive Analysis

 +1        IF $Y'<(LIN-6)

               DO HDR^FHADRPT

               DO HDR2^FHADR3A

 +2        WRITE !!!,"Nutritive Analysis 7 Days Average Regular Menu",!

 +3        QUIT