- 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 Feb 18, 2025@23:18:40 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