FHPRF ; HISC/REL - Forecasting ;2/13/95 14:27
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Production Diet Percentages
W ! S DIC="^FH(119.72,",DIC(0)="AEQM" D ^DIC G KIL:"^"[X!$D(DTOUT),EN1:Y<1 S DA=+Y
W ! S DIE="^FH(119.72,",DR="11",DR(2,119.7211)="10:16;W !" D ^DIE
S DA(1)=DA,DIK="^FH(119.72,DA(1),""A""," F DA=0:0 S DA=$O(^FH(119.72,DA(1),"A",DA)) Q:DA'>0 I $P($G(^(DA,0)),"^",2,8)?."^" D ^DIK
D KIL G EN1
EN2 ; Enter/Edit Other Meals
W ! S DIC="^FH(119.72,",DIC(0)="AEQM" D ^DIC G KIL:"^"[X!$D(DTOUT),EN2:Y<1 S DA=+Y
W ! S DIE="^FH(119.72,",DR=10,DR(2,119.721)="10:30;W !" D ^DIE
S DA(1)=DA,DIK="^FH(119.72,DA(1),""B""," F DA=0:0 S DA=$O(^FH(119.72,DA(1),"B",DA)) Q:DA'>0 I $P($G(^(DA,0)),"^",2,22)?."^" D ^DIK
D KIL G EN2
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRF 765 printed Nov 22, 2024@17:04:35 Page 2
FHPRF ; HISC/REL - Forecasting ;2/13/95 14:27
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Production Diet Percentages
+1 WRITE !
SET DIC="^FH(119.72,"
SET DIC(0)="AEQM"
DO ^DIC
if "^"[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN1
SET DA=+Y
+2 WRITE !
SET DIE="^FH(119.72,"
SET DR="11"
SET DR(2,119.7211)="10:16;W !"
DO ^DIE
+3 SET DA(1)=DA
SET DIK="^FH(119.72,DA(1),""A"","
FOR DA=0:0
SET DA=$ORDER(^FH(119.72,DA(1),"A",DA))
if DA'>0
QUIT
IF $PIECE($GET(^(DA,0)),"^",2,8)?."^"
DO ^DIK
+4 DO KIL
GOTO EN1
EN2 ; Enter/Edit Other Meals
+1 WRITE !
SET DIC="^FH(119.72,"
SET DIC(0)="AEQM"
DO ^DIC
if "^"[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN2
SET DA=+Y
+2 WRITE !
SET DIE="^FH(119.72,"
SET DR=10
SET DR(2,119.721)="10:30;W !"
DO ^DIE
+3 SET DA(1)=DA
SET DIK="^FH(119.72,DA(1),""B"","
FOR DA=0:0
SET DA=$ORDER(^FH(119.72,DA(1),"B",DA))
if DA'>0
QUIT
IF $PIECE($GET(^(DA,0)),"^",2,22)?."^"
DO ^DIK
+4 DO KIL
GOTO EN2
KIL GOTO KILL^XUSCLEAN
