FHOMRO3 ;Hines OIFO/RTK OUTPATIENT ORDER MULTIPLE DIETS ;9/28/04 10:05
;;5.5;DIETETICS;;Jan 28, 2005
;
;Code reused from FHORD1
K FHDI,PREC S N1=0
F1 ;
W ! K DIC S DIC="^FH(111,",DIC(0)="AEQMZ"
S DIC("S")="I '$D(^(""I""))&(Y>0)" D ^DIC
K DIC G AB:X[U!$D(DTOUT),F5:X="",F1:Y<1
S PREC=$P(Y(0),U,4) I PREC,$D(FHDI(PREC)) W *7,!!,"This conflicts with ",$P(FHDI(PREC),"^",2),! G F1
S N1=N1+1,FHDI(PREC)=+Y_"^"_Y(0) G F5:+Y=1,F1:N1<5 W *7,!!,"You have now selected the maximum of 5 Diet Modifications!"
F5 ;
G:'N1 AB W !!,"You have selected the following Diet:",!
S (FHD3,FHD4)=0 F FHD0=0:0 S FHD0=$O(FHDI(FHD0)) Q:FHD0="" W !?5,$P(FHDI(FHD0),U,2) S:$P(FHDI(FHD0),U,4)="Y" FHD3=1 S:$P(FHDI(FHD0),U,7)="Y" FHD4=1
F9 ;
R !!,"Is this Correct? Y// ",Y:DTIME G:'$T!(Y="^") AB S:Y="" Y="Y" S X=Y D TR^FH S Y=X
I $P("YES",Y,1)'="",$P("NO",Y,1)'="" W *7,!," Answer YES to accept diet list; NO to select diets again" G F9
I Y'?1"Y".E K FHDI S N1=0 W !!,"Select new diets ..." G F1
Q
AB K FHDI S N1=0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMRO3 1025 printed Nov 22, 2024@17:03:11 Page 2
FHOMRO3 ;Hines OIFO/RTK OUTPATIENT ORDER MULTIPLE DIETS ;9/28/04 10:05
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 ;
+3 ;Code reused from FHORD1
+4 KILL FHDI,PREC
SET N1=0
F1 ;
+1 WRITE !
KILL DIC
SET DIC="^FH(111,"
SET DIC(0)="AEQMZ"
+2 SET DIC("S")="I '$D(^(""I""))&(Y>0)"
DO ^DIC
+3 KILL DIC
if X[U!$DATA(DTOUT)
GOTO AB
if X=""
GOTO F5
if Y<1
GOTO F1
+4 SET PREC=$PIECE(Y(0),U,4)
IF PREC
IF $DATA(FHDI(PREC))
WRITE *7,!!,"This conflicts with ",$PIECE(FHDI(PREC),"^",2),!
GOTO F1
+5 SET N1=N1+1
SET FHDI(PREC)=+Y_"^"_Y(0)
if +Y=1
GOTO F5
if N1<5
GOTO F1
WRITE *7,!!,"You have now selected the maximum of 5 Diet Modifications!"
F5 ;
+1 if 'N1
GOTO AB
WRITE !!,"You have selected the following Diet:",!
+2 SET (FHD3,FHD4)=0
FOR FHD0=0:0
SET FHD0=$ORDER(FHDI(FHD0))
if FHD0=""
QUIT
WRITE !?5,$PIECE(FHDI(FHD0),U,2)
if $PIECE(FHDI(FHD0),U,4)="Y"
SET FHD3=1
if $PIECE(FHDI(FHD0),U,7)="Y"
SET FHD4=1
F9 ;
+1 READ !!,"Is this Correct? Y// ",Y:DTIME
if '$TEST!(Y="^")
GOTO AB
if Y=""
SET Y="Y"
SET X=Y
DO TR^FH
SET Y=X
+2 IF $PIECE("YES",Y,1)'=""
IF $PIECE("NO",Y,1)'=""
WRITE *7,!," Answer YES to accept diet list; NO to select diets again"
GOTO F9
+3 IF Y'?1"Y".E
KILL FHDI
SET N1=0
WRITE !!,"Select new diets ..."
GOTO F1
+4 QUIT
AB KILL FHDI
SET N1=0
QUIT
