FHOMGR1.m

FHOMGR1 ;Hines OIFO/RTK GUEST MEALS REQUEST MEAL  ;4/17/03  09:45

 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53

 ;

 D NOW^%DTC S STDT=X,FHDSDT=$$FMTE^XLFDT(STDT,"P") W !!,FHDSDT

 S FHMSG1="G" 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

FHOMGR1   ;Hines OIFO/RTK GUEST MEALS REQUEST MEAL  ;4/17/03  09:45

 +1       ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53

 +2       ;

 +3        DO NOW^%DTC

           SET STDT=X

           SET FHDSDT=$$FMTE^XLFDT(STDT,"P")

           WRITE !!,FHDSDT

 +4        SET FHMSG1="G"

           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