FHNO3.m

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

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