FHNO3 ; HISC/REL - Supplemental Feeding Lists ;5/14/93 13:36
;;5.5;DIETETICS;;Jan 28, 2005
W @IOF,!!?24,"WARD SUPPLEMENTAL FEEDING LISTS",!!
D0 R !!,"Select by S=SUPPLEMENTAL FEEDING SITE or W=WARD: ",XX:DTIME G:'$T!("^"[XX) KIL I "sw"[XX S X=XX D TR^FH S XX=X
I XX'?1U!("SW"'[XX) W *7," Enter S or W" G D0
I XX="S" S WRDS=$O(^FH(119.74,0)) I WRDS'<1,$O(^FH(119.74,WRDS))<1 G AR
I XX="W" S WRDS=$O(^FH(119.6,0)) I WRDS'<1,$O(^FH(119.6,WRDS))<1 S WRDS=0 G AR
I XX="S" G D2
D1 R !!,"Select WARD (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRDS=0,XX="W"
I X'="ALL" K DIC S DIC="^FH(119.6,",DIC(0)="EMQ" D ^DIC G:Y<1 D1 S WRDS=+Y
G AR
D2 R !!,"Select SUPPLEMENTAL FEEDING SITE (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRDS=0,XX="S"
I X'="ALL" K DIC S DIC="^FH(119.74,",DIC(0)="EMQ" D ^DIC G:Y<1 D2 S WRDS=+Y
AR R !!,"Print Patients: (A=Alphabetically R=Room-Bed) R// ",PRN:DTIME G:'$T!(PRN["^") KIL S:PRN="" PRN="R" I "ar"[PRN S X=PRN D TR^FH S PRN=X
I PRN'?1U!("AR"'[PRN) W *7," Enter A or R" G AR
L0 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="^FHNO31",FHLST="WRDS^XX^PRN" D EN2^FH G KIL:'WRDS,D0
U IO D ^FHNO31 D ^%ZISC K %ZIS,IOP G KIL:'WRDS,D0
KIL K ^TMP($J),^TMP("FH",$J) G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNO3 1340 printed Sep 23, 2025@19:28:18 Page 2
FHNO3 ; HISC/REL - Supplemental Feeding Lists ;5/14/93 13:36
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 WRITE @IOF,!!?24,"WARD SUPPLEMENTAL FEEDING LISTS",!!
D0 READ !!,"Select by S=SUPPLEMENTAL FEEDING SITE or W=WARD: ",XX:DTIME
if '$TEST!("^"[XX)
GOTO KIL
IF "sw"[XX
SET X=XX
DO TR^FH
SET XX=X
+1 IF XX'?1U!("SW"'[XX)
WRITE *7," Enter S or W"
GOTO D0
+2 IF XX="S"
SET WRDS=$ORDER(^FH(119.74,0))
IF WRDS'<1
IF $ORDER(^FH(119.74,WRDS))<1
GOTO AR
+3 IF XX="W"
SET WRDS=$ORDER(^FH(119.6,0))
IF WRDS'<1
IF $ORDER(^FH(119.6,WRDS))<1
SET WRDS=0
GOTO AR
+4 IF XX="S"
GOTO D2
D1 READ !!,"Select WARD (or ALL): ",X:DTIME
if '$TEST!("^"[X)
GOTO KIL
if X="all"
DO TR^FH
IF X="ALL"
SET WRDS=0
SET XX="W"
+1 IF X'="ALL"
KILL DIC
SET DIC="^FH(119.6,"
SET DIC(0)="EMQ"
DO ^DIC
if Y<1
GOTO D1
SET WRDS=+Y
+2 GOTO AR
D2 READ !!,"Select SUPPLEMENTAL FEEDING SITE (or ALL): ",X:DTIME
if '$TEST!("^"[X)
GOTO KIL
if X="all"
DO TR^FH
IF X="ALL"
SET WRDS=0
SET XX="S"
+1 IF X'="ALL"
KILL DIC
SET DIC="^FH(119.74,"
SET DIC(0)="EMQ"
DO ^DIC
if Y<1
GOTO D2
SET WRDS=+Y
AR READ !!,"Print Patients: (A=Alphabetically R=Room-Bed) R// ",PRN:DTIME
if '$TEST!(PRN["^")
GOTO KIL
if PRN=""
SET PRN="R"
IF "ar"[PRN
SET X=PRN
DO TR^FH
SET PRN=X
+1 IF PRN'?1U!("AR"'[PRN)
WRITE *7," Enter A or R"
GOTO AR
L0 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select LIST Printer: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+1 IF $DATA(IO("Q"))
SET FHPGM="^FHNO31"
SET FHLST="WRDS^XX^PRN"
DO EN2^FH
if 'WRDS
GOTO KIL
GOTO D0
+2 USE IO
DO ^FHNO31
DO ^%ZISC
KILL %ZIS,IOP
if 'WRDS
GOTO KIL
GOTO D0
KIL KILL ^TMP($JOB),^TMP("FH",$JOB)
GOTO KILL^XUSCLEAN
