- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHADR61 1500 printed Mar 13, 2025@20:51:13 Page 2
- 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
