- 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 Mar 13, 2025@20:59:03 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
