FHOMGR1 ;Hines OIFO/RTK GUEST MEALS REQUEST MEAL ;4/17/03 09:45
;;5.5;DIETETICS;**5,24**;Jan 28, 2005;Build 3
;
D NOW^%DTC S STDT=X,FHDSDT=$$FMTE^XLFDT(STDT,"P") W !!,FHDSDT
S FHMSG1="G",FHALL=0 D ^FHOMDPA I FHDFN="" Q
I '$D(^FHPT(FHDFN,0)) W !!,"UNKNOWN SELECTION !" Q
CLASS ;Prompt for classification
W ! K DIR,DIC S DIR("A")="Select Classification: "
S DIR(0)="SAO^E:Employee;G:Gratuitous;O:OOD;P:Paid;V:Volunteer"
D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
I Y'=-1 S FHCLASS=Y
LOC ;Prompt for location
D OUTLOC^FHOMUTL I FHLOC="" D EXMSG^FHOMUTL Q
W ! D RMBED^FHOMUTL
S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8)
MEAL ;Prompt for meal
K DIR,DIC S DIR("A")="Select Meal: "
S DIR(0)="SAO^B:Breakfast;N:Noon;E:Evening"
D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
I Y'=-1 S FHMEAL=Y
DIET ;Stuff diet
S FHDIET=$P($G(^FH(119.9,1,0)),U,2)
I FHDIET="" W !!,"NO DEFAULT OUTPATIENT DIET SET!!",! Q
CHARGE ;Get charge
S FHCHAR=""
S F=$S(FHCLASS="E":12,FHCLASS="P":13,FHCLASS="O":14,FHCLASS="V":15,1:16)
S FHYN=$P($G(^FH(119.9,1,0)),U,F) I FHYN'="Y" W ! D SET1 Q
S F=$S(FHCLASS="E":21,FHCLASS="P":24,FHCLASS="O":27,FHCLASS="V":30,1:33)
S FHP=F+$S(FHMEAL="B":0,FHMEAL="N":1,1:2)
S FHCHAR=$P($G(^FH(119.9,1,0)),U,FHP)
W !!,"Payment amount = $",FHCHAR,!
SET1 K DIR S DIR("A")="Is this correct?: ",DIR(0)="YA",DIR("B")="Y" D ^DIR
S CONT=Y I CONT'=1 D EXMSG^FHOMUTL Q
S FHGML=1 D SMGM^FHOMRO2 I SKIP=1 Q
SETNODE ;
S MLT=$S(FHMEAL="B":".08",FHMEAL="N":".13",1:".18")
S STDTIM=STDT_MLT
I $D(^FHPT(FHDFN,"GM","B",STDTIM)),$P($G(^FHPT(FHDFN,"GM",STDTIM,0)),U,9)'="C" D MESSAGE Q
S DA(1)=FHDFN,DA=STDTIM,DIK="^FHPT("_DA(1)_",""GM""," D ^DIK ;delete if there is a previous canceled GM for this date/meal
S Y=STDTIM K DIC,DO S DA(1)=FHDFN,DIC="^FHPT("_DA(1)_",""GM"","
S DIC(0)="L",DIC("P")=$P(^DD(115,18,0),U,2),X=+Y,DINUM=X
D FILE^DICN I Y=-1 Q
K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""GM"","
S DA=+Y,FHDA=DA
S DR="1////^S X=FHCLASS;2////^S X=FHMEAL;3////^S X=FHCHAR;4////^S X=FHLOC;4.5////^S X=FHRMBD;5////^S X=FHDIET"
D ^DIE,OKMSG^FHOMUTL
S FHZN=$G(^FHPT(FHDFN,"GM",FHDA,0))
S FHACT="O",FHOPTY="G",FHOPDT=STDT D SETGM^FHOMRO2 ;set event
Q
MESSAGE ;
D PATNAME^FHOMUTL S FHPREDT=$$FMTE^XLFDT(STDT,"P")
W !!?3,FHPTNM," ALREADY HAS A "
W $S(FHMEAL="B":"BREAKFAST",FHMEAL="N":"NOON",1:"EVENING")
W " GUEST MEAL ORDERED FOR ",FHPREDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMGR1 2402 printed Apr 09, 2024@20:53:15 Page 2
FHOMGR1 ;Hines OIFO/RTK GUEST MEALS REQUEST MEAL ;4/17/03 09:45
+1 ;;5.5;DIETETICS;**5,24**;Jan 28, 2005;Build 3
+2 ;
+3 DO NOW^%DTC
SET STDT=X
SET FHDSDT=$$FMTE^XLFDT(STDT,"P")
WRITE !!,FHDSDT
+4 SET FHMSG1="G"
SET FHALL=0
DO ^FHOMDPA
IF FHDFN=""
QUIT
+5 IF '$DATA(^FHPT(FHDFN,0))
WRITE !!,"UNKNOWN SELECTION !"
QUIT
CLASS ;Prompt for classification
+1 WRITE !
KILL DIR,DIC
SET DIR("A")="Select Classification: "
+2 SET DIR(0)="SAO^E:Employee;G:Gratuitous;O:OOD;P:Paid;V:Volunteer"
+3 DO ^DIR
IF $DATA(DIRUT)
DO EXMSG^FHOMUTL
QUIT
+4 IF Y'=-1
SET FHCLASS=Y
LOC ;Prompt for location
+1 DO OUTLOC^FHOMUTL
IF FHLOC=""
DO EXMSG^FHOMUTL
QUIT
+2 WRITE !
DO RMBED^FHOMUTL
+3 SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
MEAL ;Prompt for meal
+1 KILL DIR,DIC
SET DIR("A")="Select Meal: "
+2 SET DIR(0)="SAO^B:Breakfast;N:Noon;E:Evening"
+3 DO ^DIR
IF $DATA(DIRUT)
DO EXMSG^FHOMUTL
QUIT
+4 IF Y'=-1
SET FHMEAL=Y
DIET ;Stuff diet
+1 SET FHDIET=$PIECE($GET(^FH(119.9,1,0)),U,2)
+2 IF FHDIET=""
WRITE !!,"NO DEFAULT OUTPATIENT DIET SET!!",!
QUIT
CHARGE ;Get charge
+1 SET FHCHAR=""
+2 SET F=$SELECT(FHCLASS="E":12,FHCLASS="P":13,FHCLASS="O":14,FHCLASS="V":15,1:16)
+3 SET FHYN=$PIECE($GET(^FH(119.9,1,0)),U,F)
IF FHYN'="Y"
WRITE !
DO SET1
QUIT
+4 SET F=$SELECT(FHCLASS="E":21,FHCLASS="P":24,FHCLASS="O":27,FHCLASS="V":30,1:33)
+5 SET FHP=F+$SELECT(FHMEAL="B":0,FHMEAL="N":1,1:2)
+6 SET FHCHAR=$PIECE($GET(^FH(119.9,1,0)),U,FHP)
+7 WRITE !!,"Payment amount = $",FHCHAR,!
SET1 KILL DIR
SET DIR("A")="Is this correct?: "
SET DIR(0)="YA"
SET DIR("B")="Y"
DO ^DIR
+1 SET CONT=Y
IF CONT'=1
DO EXMSG^FHOMUTL
QUIT
+2 SET FHGML=1
DO SMGM^FHOMRO2
IF SKIP=1
QUIT
SETNODE ;
+1 SET MLT=$SELECT(FHMEAL="B":".08",FHMEAL="N":".13",1:".18")
+2 SET STDTIM=STDT_MLT
+3 IF $DATA(^FHPT(FHDFN,"GM","B",STDTIM))
IF $PIECE($GET(^FHPT(FHDFN,"GM",STDTIM,0)),U,9)'="C"
DO MESSAGE
QUIT
+4 ;delete if there is a previous canceled GM for this date/meal
SET DA(1)=FHDFN
SET DA=STDTIM
SET DIK="^FHPT("_DA(1)_",""GM"","
DO ^DIK
+5 SET Y=STDTIM
KILL DIC,DO
SET DA(1)=FHDFN
SET DIC="^FHPT("_DA(1)_",""GM"","
+6 SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(115,18,0),U,2)
SET X=+Y
SET DINUM=X
+7 DO FILE^DICN
IF Y=-1
QUIT
+8 KILL DIE
SET DA(1)=FHDFN
SET DIE="^FHPT("_DA(1)_",""GM"","
+9 SET DA=+Y
SET FHDA=DA
+10 SET DR="1////^S X=FHCLASS;2////^S X=FHMEAL;3////^S X=FHCHAR;4////^S X=FHLOC;4.5////^S X=FHRMBD;5////^S X=FHDIET"
+11 DO ^DIE
DO OKMSG^FHOMUTL
+12 SET FHZN=$GET(^FHPT(FHDFN,"GM",FHDA,0))
+13 ;set event
SET FHACT="O"
SET FHOPTY="G"
SET FHOPDT=STDT
DO SETGM^FHOMRO2
+14 QUIT
MESSAGE ;
+1 DO PATNAME^FHOMUTL
SET FHPREDT=$$FMTE^XLFDT(STDT,"P")
+2 WRITE !!?3,FHPTNM," ALREADY HAS A "
+3 WRITE $SELECT(FHMEAL="B":"BREAKFAST",FHMEAL="N":"NOON",1:"EVENING")
+4 WRITE " GUEST MEAL ORDERED FOR ",FHPREDT
+5 QUIT
