source: FOIAVistA/trunk/r/DIETETICS-FH/FHOMRE1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1FHOMRE1 ;Hines OIFO/RTK-OUTPATIENT MEALS EARLY/LATE TRAY ;5/20/03 08:35
2 ;;5.5;DIETETICS;**2,11**;Jan 28, 2005;Build 4
3 ;
4 ;09/08/2006 KAM/BAY Remedy Call 149576 - Add check for provide bagged meal
5 ;
6 S FHMSG1="E" D EN1,END Q
7EN1 D GETOPT^FHOMUTL I FHFIND=0 Q
8 K NUM D DISP^FHOMRR1 I $G(NUM)="" Q
9EL1 K DIR S DIR(0)="NAO^1:"_NUM,DIR("A")="Early/Late Tray For Which Order? "
10 D ^DIR Q:$D(DIRUT)
11 S FHRMSEL=Y,FHC=FHRMSEL,FHRNUM=$P(FHLIST(FHRMSEL),U,1)
12 S FHRMDT=$P(FHLIST(FHRMSEL),U,2),Y=FHRMDT D DD^%DT W !,Y,!
13 I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" W !!?3,"The selected order has been cancelled!",! D EL1 Q
14 I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) W !,"Early/Late Tray already exists for this meal." K DIR S DIR(0)="YA",DIR("A")="Do you wish to overwrite? ",DIR("B")="N" D ^DIR Q:$D(DIRUT) Q:Y'=1
15 ; Only allow selection of one order at a time, rather than a range
16 ; because they could be different meals which could have different
17 ; allowable meal window times.
18 K DIR S DIR(0)="SAO^E:EARLY;L:LATE",DIR("A")="Early or Late (E or L)? "
19 D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
20 S FHEL=Y
21ORD S FHLOC=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,3),FHORN="",FHMSG1="E"
22 S FHDIET=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,2)
23 S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8),FHCOMM1=$G(^FH(119.73,FHCOMM,1))
24 S FHMEAL=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)
25 S FH1=$S(FHMEAL="B":1,FHMEAL="N":7,1:13) I FHEL="L" S FH1=FH1+3
26TIME S FH3=FH1+2,FHCNT=0 F FHT=FH1:1:FH3 D
27 .I $P(FHCOMM1,U,FHT)="" Q
28 .S FHCNT=FHCNT+1,FHTM(FHCNT)=$P(FHCOMM1,U,FHT)
29 W !,"Select Time: ( " F J=1:1:FHCNT W J,"=",FHTM(J)," "
30 R ") ",FHS:DTIME I FHS=""!(FHS["^") D EXMSG^FHOMUTL Q
31 I (FHS'?1N)!(FHS<1)!(FHS>FHCNT) W !!,"Invalid time selection!" D TIME Q
32 S FHTIME=FHTM(FHS),X=FHRMDT_"@"_FHTIME,%DT="XT" D ^%DT S FHDTM=Y
33 D NOW^%DTC I FHDTM<% W !!,"Cannot order for a Date/Time before now!" D TIME Q
34 ;09/08/2006 KAM/BAY Rem Call 149576 Check file 119.73 PROVIDE BAGGED MEAL
35 ;
36 S FHBAG="N" I $P($G(^FH(119.73,FHCOMM,2)),U,10)="Y" D
37 . K DIR S DIR(0)="SAO^Y:Yes;N:No",DIR("A")="Bagged Meal? ",DIR("B")="N"
38 . D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
39 . S FHBAG=Y
40 D SET,UPD100,OKMSG^FHOMUTL,END Q
41 ;
42SET S DA=FHRNUM,DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
43 S FHORN=$S($G(FHORN)="":"",1:FHORN)
44 D NOW^%DTC S FHTODAY=$E(%,1,12)
45 S DR="14////^S X=FHTIME;15////^S X=FHBAG;16////^S X=DUZ;17////^S X=FHTODAY;17.5////^S X=FHORN;17.6////^S X=""@""" D ^DIE
46 S FHACT="O",FHOPTY="E",FHAET=FHTIME D SETAET^FHOMRO2
47 Q
48END K A,FHFIND,FHCLST,FHC,FHCOMM,FH1,FH3,FHTEXT,NUM
49 K FHSEL,FHT,FHCNT,FHCOMM1,FHS Q
50 Q
51HL7SET ;
52 ; Entry point for E/L trays placed from CPRS/OERR
53 S (FHRFLG,FHSFLG)=0,FHMEAL=$E(FHSVCP,1),FILL=""
54 S FHEL=$E(FHSVCP,2),FHTM=$E(FHSVCP,3)
55 I FHEL'?1"E",FHEL'?1"L" S TXT="Missing E/L" D GETOR^FHWOR,ERR^FHOMWOR Q
56 I FHTM<1!(FHTM>3) S TXT="Invalid time" D GETOR^FHWOR,ERR^FHOMWOR Q
57 S FHRMDT=STDT,ENDT=FHRMDT_.9999
58 S FH1=$S(FHMEAL="B":1,FHMEAL="N":7,1:13) I FHEL="L" S FH1=FH1+3
59 S FH1=FH1+FHTM-1
60 S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8),FHCOMM1=$G(^FH(119.73,FHCOMM,1))
61 S FHTIME=$P(FHCOMM1,U,FH1),X1=STDT,X2=-1 D C^%DTC S STDT1=X
62RM ; Check recurring meals
63 I '$D(^FHPT(FHDFN,"OP","B",FHRMDT)) D SM Q
64 F FHRMDT=STDT1:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(FHRMDT>ENDT) F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0 D
65 .Q:$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)'=FHMEAL
66 .Q:$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C"
67 .S FHRNUM1=FHRNUM,FHRFLG=1 D SET Q
68 S FILL="E;"_$G(FHRNUM1)
69SM ; Check special meals
70 F FHSMDT=STDT:0 S FHSMDT=$O(^FHPT(FHDFN,"SM",FHSMDT)) Q:FHSMDT'>0!(FHSMDT>ENDT) D SETELSM
71 ;
72 I FHRFLG=0,FHSFLG=0 D REJECT Q
73 I FILL="" D REJECT Q
74 D SEND^FHWOR
75 Q
76SETELSM ; Set E/L for Special Meals
77 Q:$P($G(^FHPT(FHDFN,"SM",FHSMDT,0)),U,9)'=FHMEAL
78 S FHSFLG=1,DA=FHSMDT,DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""SM"","
79 D NOW^%DTC S FHTODAY=$E(%,1,12)
80 S FHORN=$S($G(FHORN)="":"",1:FHORN),FILL="G;"_FHSMDT
81 S DR="8////^S X=FHTIME;9////^S X=FHBAG;10////^S X=DUZ;11////^S X=FHORN" D ^DIE
82 S FHZN=$G(^FHPT(FHDFN,"SM",FHSMDT,0))
83 S FHACT="O",FHOPTY="S",FHSTAT="",FHOPDT=FHTODAY D SETSM^FHOMRO2
84 Q
85REJECT ; Reject if no recurring or special meals found
86 S TXT="No Recurring or Special Meal ordered for this date/meal"
87 D GETOR^FHWOR,ERR^FHOMWOR Q
88 Q
89UPD100 ;Backdoor message to update file #100 with a new EL order
90 Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
91 Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
92 S FILL="E;"_FHRNUM,FHODT=$$FMTHL7^XLFDT(FHRMDT)
93 S FHOMELN=FHMEAL_FHEL_FHS,FHOBAG="" I FHBAG="Y" S FHOBAG="bagged"
94 S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHTODAY
95 S MSG(5)="ODT|"_$S(FHEL="E":"EARLY",1:"LATE")_"|^^^"_FHOMELN_"^^99FHD|"_FHOBAG
96 D EVSEND^FHWOR
97 Q
Note: See TracBrowser for help on using the repository browser.