FHORT5.m

FHORT5 ; HISC/REL/NCA/RVD - Tubefeeding Reports ;3/1/04  13:31

 ;;5.5;DIETETICS;;Jan 28, 2005

 ;

ALL ; Print All Reports

 S FHOPT=1 G A0

PREP ; Print Preparation Report Only

 S FHOPT=2 G A0

COST ; Print Tubefeed Cost Report

 S FHOPT=3 G A0

LAB ; Print Tubefeed Labels

 S FHOPT=4 G A0

PULL ; Product Pick List

 S FHOPT=5 G A0

A0 R !!,"Select C=COMMUNICATION OFFICE or L=LOCATION: ",FHXX:DTIME G:'$T!("^"[FHXX) KIL I "cl"[FHXX S X=FHXX D TR^FH S FHXX=X

 I FHXX'?1U!("CL"'[FHXX) W *7,"Enter C or L" G A0

 I FHXX="C" G A2

A1 R !!,"Select LOCATION (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S FHP=0,FHXX="L",WRD=0

 E  K DIC S DIC="^FH(119.6,",DIC(0)="EQM" D ^DIC G:Y<1 A1 S FHP=+Y,WRD=$P(Y,"^",2)

 G A3

A2 S FHP=$O(^FH(119.73,0)) I FHP'<1,$O(^FH(119.73,FHP))<1 G A3

 R !!,"Select COMMUNICATION OFFICE (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S FHP=0,FHXX="C",WRD=0

 I X'="ALL" K DIC S DIC="^FH(119.73,",DIC(0)="EMQ" D ^DIC G:Y<1 A2 S FHP=+Y

A3 S (SUM,MUL)=0 G A5:FHOPT=4,A6:FHP

A4 R !!,"Consolidated Report Only? Y// ",X:DTIME G:'$T!(X["^") KIL S:X="" X="Y" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7,"  Answer YES or NO" G A4

 S SUM=X?1"Y".E G A6

A5 W ! K DIR,LABSTART S DIR(0)="NA^1:10",DIR("A")="If using laser label sheets, what row do you want to begin printing at? ",DIR("B")=1 D ^DIR

 Q:$D(DIRUT)  S LABSTART=Y

 R !!,"Do you want multiple labels? N// ",X:DTIME G:'$T!(X["^") KIL S:X="" X="N" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7,"  Enter YES or NO" G A5

 S MUL=X?1"Y".E

A6 I FHOPT'>2 W !!,"The report requires a 132 column printer.",!

 W ! K IOP,%ZIS S %ZIS("A")="Select "_$S(FHOPT=4:"LABEL",1:"LIST")_" Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) S FHPGM="Q1^FHORT5A",FHLST="FHXX^FHOPT^FHP^WRD^SUM^MUL^LABSTART" D EN2^FH G KIL

 U IO D Q1^FHORT5A D ^%ZISC K %ZIS,IOP G KIL

KIL K ^TMP($J) G KILL^XUSCLEAN

FHORT5    ; HISC/REL/NCA/RVD - Tubefeeding Reports ;3/1/04  13:31

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

 +2       ;

ALL       ; Print All Reports

 +1        SET FHOPT=1

           GOTO A0

PREP      ; Print Preparation Report Only

 +1        SET FHOPT=2

           GOTO A0

COST      ; Print Tubefeed Cost Report

 +1        SET FHOPT=3

           GOTO A0

LAB       ; Print Tubefeed Labels

 +1        SET FHOPT=4

           GOTO A0

PULL      ; Product Pick List

 +1        SET FHOPT=5

           GOTO A0

A0         READ !!,"Select C=COMMUNICATION OFFICE or L=LOCATION: ",FHXX:DTIME

           IF '$TEST!("^"[FHXX)

               GOTO KIL

           IF "cl"[FHXX

               SET X=FHXX

               DO TR^FH

               SET FHXX=X

 +1        IF FHXX'?1U!("CL"'[FHXX)

               WRITE *7,"Enter C or L"

               GOTO A0

 +2        IF FHXX="C"

               GOTO A2

A1         READ !!,"Select LOCATION (or ALL): ",X:DTIME

           IF '$TEST!("^"[X)

               GOTO KIL

           IF X="all"

               DO TR^FH

           IF X="ALL"

               SET FHP=0

               SET FHXX="L"

               SET WRD=0

 +1       IF '$TEST

               KILL DIC

               SET DIC="^FH(119.6,"

               SET DIC(0)="EQM"

               DO ^DIC

               IF Y<1

                   GOTO A1

               SET FHP=+Y

               SET WRD=$PIECE(Y,"^",2)

 +2        GOTO A3

A2         SET FHP=$ORDER(^FH(119.73,0))

           IF FHP'<1

               IF $ORDER(^FH(119.73,FHP))<1

                   GOTO A3

 +1        READ !!,"Select COMMUNICATION OFFICE (or ALL): ",X:DTIME

           IF '$TEST!("^"[X)

               GOTO KIL

           IF X="all"

               DO TR^FH

           IF X="ALL"

               SET FHP=0

               SET FHXX="C"

               SET WRD=0

 +2        IF X'="ALL"

               KILL DIC

               SET DIC="^FH(119.73,"

               SET DIC(0)="EMQ"

               DO ^DIC

               IF Y<1

                   GOTO A2

               SET FHP=+Y

A3         SET (SUM,MUL)=0

           IF FHOPT=4

               GOTO A5

           IF FHP

               GOTO A6

A4         READ !!,"Consolidated Report Only? Y// ",X:DTIME

           IF '$TEST!(X["^")

               GOTO KIL

           IF X=""

               SET X="Y"

           DO TR^FH

           IF $PIECE("YES",X,1)'=""

               IF $PIECE("NO",X,1)'=""

                   WRITE *7,"  Answer YES or NO"

                   GOTO A4

 +1        SET SUM=X?1"Y".E

           GOTO A6

A5         WRITE !

           KILL DIR,LABSTART

           SET DIR(0)="NA^1:10"

           SET DIR("A")="If using laser label sheets, what row do you want to begin printing at? "

           SET DIR("B")=1

           DO ^DIR

 +1        IF $DATA(DIRUT)

               QUIT 

           SET LABSTART=Y

 +2        READ !!,"Do you want multiple labels? N// ",X:DTIME

           IF '$TEST!(X["^")

               GOTO KIL

           IF X=""

               SET X="N"

           DO TR^FH

           IF $PIECE("YES",X,1)'=""

               IF $PIECE("NO",X,1)'=""

                   WRITE *7,"  Enter YES or NO"

                   GOTO A5

 +3        SET MUL=X?1"Y".E

A6         IF FHOPT'>2

               WRITE !!,"The report requires a 132 column printer.",!

 +1        WRITE !

           KILL IOP,%ZIS

           SET %ZIS("A")="Select "_$SELECT(FHOPT=4:"LABEL",1:"LIST")_" Printer: "

           SET %ZIS="MQ"

           DO ^%ZIS

           KILL %ZIS,IOP

           IF POP

               GOTO KIL

 +2        IF $DATA(IO("Q"))

               SET FHPGM="Q1^FHORT5A"

               SET FHLST="FHXX^FHOPT^FHP^WRD^SUM^MUL^LABSTART"

               DO EN2^FH

               GOTO KIL

 +3        USE IO

           DO Q1^FHORT5A

           DO ^%ZISC

           KILL %ZIS,IOP

           GOTO KIL

KIL        KILL ^TMP($JOB)

           GOTO KILL^XUSCLEAN