source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHORT5.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1FHORT5 ; HISC/REL/NCA/RVD - Tubefeeding Reports ;3/1/04 13:31
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ;
4ALL ; Print All Reports
5 S FHOPT=1 G A0
6PREP ; Print Preparation Report Only
7 S FHOPT=2 G A0
8COST ; Print Tubefeed Cost Report
9 S FHOPT=3 G A0
10LAB ; Print Tubefeed Labels
11 S FHOPT=4 G A0
12PULL ; Product Pick List
13 S FHOPT=5 G A0
14A0 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
15 I FHXX'?1U!("CL"'[FHXX) W *7,"Enter C or L" G A0
16 I FHXX="C" G A2
17A1 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
18 E K DIC S DIC="^FH(119.6,",DIC(0)="EQM" D ^DIC G:Y<1 A1 S FHP=+Y,WRD=$P(Y,"^",2)
19 G A3
20A2 S FHP=$O(^FH(119.73,0)) I FHP'<1,$O(^FH(119.73,FHP))<1 G A3
21 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
22 I X'="ALL" K DIC S DIC="^FH(119.73,",DIC(0)="EMQ" D ^DIC G:Y<1 A2 S FHP=+Y
23A3 S (SUM,MUL)=0 G A5:FHOPT=4,A6:FHP
24A4 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
25 S SUM=X?1"Y".E G A6
26A5 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
27 Q:$D(DIRUT) S LABSTART=Y
28 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
29 S MUL=X?1"Y".E
30A6 I FHOPT'>2 W !!,"The report requires a 132 column printer.",!
31 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
32 I $D(IO("Q")) S FHPGM="Q1^FHORT5A",FHLST="FHXX^FHOPT^FHP^WRD^SUM^MUL^LABSTART" D EN2^FH G KIL
33 U IO D Q1^FHORT5A D ^%ZISC K %ZIS,IOP G KIL
34KIL K ^TMP($J) G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.