source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHMTK1.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1FHMTK1 ; HISC/REL/NCA - Tray Tickets ;4/20/95 15:28
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3F0 ;
4 K FHOMF,DFN,IEN200 S FHBY="",FHTTDFN=0
5 K DIR S DIR(0)="SBAO^P:Patient;C:Communication Office;L:Location;A:All"
6 S DIR("B")="COMM"
7 S DIR("A")="Print by PATIENT, COMMUNICATION OFFICE, LOCATION or ALL? "
8 D ^DIR I $D(DIRUT) D KIL Q
9 S FHBY=Y
10 I FHBY="P" D P0 Q
11 I FHBY="C" D C0 Q
12 I FHBY="L" D NL0 Q
13 I FHBY="A" S (DFN,FHP,W1)="" D S0 Q
14 Q
15C0 ; Sort by Communication Office
16 S FHP=$O(^FH(119.73,0))
17 I FHP'<1,$O(^FH(119.73,FHP))<1 S (DFN,W1)="" G S0
18 K DIC S DIC="^FH(119.73,",DIC("A")="Select COMMUNICATION OFFICE: "
19 S DIC(0)="AEQM" W ! D ^DIC K DIC
20 G KIL:"^"[X!$D(DTOUT),C0:Y<1 S FHP=+Y,(DFN,W1)="" G S0
21NL0 ; Sort by Location
22 K DIC S DIC="^FH(119.6,",DIC("A")="Select NUTRITION LOCATION: "
23 S DIC(0)="AEQM" W ! D ^DIC K DIC
24 G KIL:"^"[X!$D(DTOUT),NL0:Y<1 S W1=+Y,(DFN,FHP)="" G S0
25P0 ; Single patient
26 S FHALL=1 D ^FHOMDPA S FHTTDFN=FHDFN I 'FHDFN D KIL Q
27 I 'DFN D P1 Q
28 I $G(^DPT(DFN,.1))="" D P1 Q
29 S (FHP,W1)="",SRT="R" G F1
30 I $P($G(^DPT(DFN,.35)),"^",1) W !!?5," [ Patient has expired. ]" G KIL
31S0 ; Start
32 I $G(TABREC)="YES" S SRT="A" G F1
33 R !!,"Sort Patients: (A=Alphabetically R=Room-Bed) R// ",SRT:DTIME G:'$T!(SRT["^") KIL S:SRT="" SRT="R" I "ar"[SRT S X=SRT D TR^FH S SRT=X
34 I SRT'?1U!("AR"'[SRT) W *7," Enter A or R" G S0
35F1 S %DT("A")="Select Date: ",%DT="AEFX",%DT("B")="TODAY",%DT(0)=DT W ! D ^%DT G KIL:"^"[X!$D(DTOUT),F1:Y<1 S (X1,D1)=+Y
36 D E1^FHPRC1 I FHCY<1 W *7,!!,"No MENU CYCLE Defined for that Date!" G F1
37 I '$D(^FH(116,FHCY,"DA",FHDA,0)) W *7,!!,"MENU CYCLE DAY Not Defined for that Date!" G F1
38R1 R !!,"Select MEAL (B,N,E,or ALL): ",MEAL:DTIME G:'$T!("^"[MEAL) KIL S X=MEAL D TR^FH S MEAL=X S:$P("ALL",MEAL,1)="" MEAL="A"
39 I "BNEA"'[MEAL!(MEAL'?1U) W *7,!,"Select B for Breakfast, N for Noon, or E for Evening or ALL for all meals" G R1
40 S FHOMEAL=MEAL,FHDA=^FH(116,FHCY,"DA",FHDA,0)
41 I $D(^FH(116.3,D1,0)) S X=^(0) F LL=2:1:4 I $P(X,"^",LL) S $P(FHDA,"^",LL)=$P(X,"^",LL)
42 I MEAL="A" F LP="B","N","E" S FHX1=$P(FHDA,"^",$F("BNE",LP)) I 'FHX1 W *7,!!,"*** NO MENU DEFINED FOR ",$S(LP="B":"BREAKFAST",LP="N":"NOON",1:"EVENING")," ***" G KIL
43 S (SUM,UPD)=0 G:MEAL="A" D5
44 S FHX1=$P(FHDA,"^",$F("BNE",MEAL)) I 'FHX1 W *7,!!,"*** NO MENU DEFINED FOR THIS MEAL ***" G KIL
45 ;I $G(IEN200)'="",$G(FHOMF)=1 Q
46 G L0:DFN,R2
47D5 G:DFN!($G(IEN200)'="") L0 R !!,"Consolidated List? 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 D5
48 S SUM=X?1"Y".E
49R2 I $G(TABREC)="YES" G L0
50 R !!,"Print Only Ones With Order Changes related to the Tray Ticket? 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,!," Answer YES or NO" G R2
51 S UPD=X?1"Y".E
52L0 ;I $G(FHOMF)=1 Q
53 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
54 I $D(IO("Q")) S FHPGM="B1^FHMTK1A",FHLST="D1^MEAL^IEN200^FHOMEAL^FHOMF^FHBY^FHDFN^FHTTDFN^FHX1^FHP^W1^DFN^FHDA^SUM^UPD^SRT^TABREC" D EN2^FH G KIL
55 U IO D B1^FHMTK1A D ^%ZISC K %ZIS,IOP G KIL
56KIL K ^TMP($J),TABREC G KILL^XUSCLEAN
57 ;
58TABREC ; Entry point for separate Print Tab Recipes option
59 S TABREC="YES" D F0
60 K TABREC Q
61P1 ; Tray tickets for single outpatient
62 S (FHP,W1)="",SRT="R",FHOMF=1,NBR=0,MFLG=0
63 S FHBOT=$P($G(^FH(119.9,1,4)),"^",1) D F1
64 S LN=$S(IOST?1"C".E:IOSL-2,1:IOSL-6),SL=40
65 I '$D(MEAL) Q
66 I MEAL="A" S MFLG=1
67 D ^FHOMTK1 Q
68 Q
Note: See TracBrowser for help on using the repository browser.