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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORT5 1925 printed Apr 09, 2024@20:54:42 Page 2
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
