FHOMSC1.m

FHOMSC1 ;Hines OIFO/RTK SPECIAL MEALS CANCEL MEAL  ;4/15/03  8:55

 ;;5.5;DIETETICS;**2**;Jan 28, 2005

 ;

 S FHORN="",STDT=DT,FHS="ADP" D LIST^FHOMSS1 W !

 I NUM=0 W !,"NO SPECIAL MEALS TO CANCEL" Q

 K DIR S DIR("A")="Cancel Which Meal(s)?",DIR(0)="LO^1:"_NUM D ^DIR

 Q:$D(DIRUT)  S FHCLST=Y

 W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR

 Q:$D(DIRUT)  I Y=0 D END Q

 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC=""  S FHCDT=FHLIST(FHC) D CAN,CNSM100^FHOMRC2

 W "  ... done" Q

 Q

CAN ;

 S FHSTAT="C"

 S DA=$P(FHCDT,U,2),FHDA=DA,DA(1)=$P(FHCDT,U,1),FHDFN=DA(1)

 I FHORN="" S FHORN=$P($G(^FHPT(FHDFN,"SM",FHDA,0)),U,12)

 I '$D(^FHPT(DA(1),"SM",DA,0)) Q

 S DIE="^FHPT("_DA(1)_",""SM"","

 S DR="1////^S X=FHSTAT;14////^S X=FHORN;11.5////^S X=FHSTAT" D ^DIE

 S FHZN=$G(^FHPT(FHDFN,"SM",FHDA,0))

 S FHACT="C",FHOPTY="S",FHOPDT=FHDA D SETSM^FHOMRO2

 Q

END ;

 K FHS,FHSTAT Q

FHOMSC1   ;Hines OIFO/RTK SPECIAL MEALS CANCEL MEAL  ;4/15/03  8:55

 +1       ;;5.5;DIETETICS;**2**;Jan 28, 2005

 +2       ;

 +3        SET FHORN=""

           SET STDT=DT

           SET FHS="ADP"

           DO LIST^FHOMSS1

           WRITE !

 +4        IF NUM=0

               WRITE !,"NO SPECIAL MEALS TO CANCEL"

               QUIT 

 +5        KILL DIR

           SET DIR("A")="Cancel Which Meal(s)?"

           SET DIR(0)="LO^1:"_NUM

           DO ^DIR

 +6        IF $DATA(DIRUT)

               QUIT 

           SET FHCLST=Y

 +7        WRITE !

           KILL DIR

           SET DIR("A")="Are you sure? "

           SET DIR(0)="YA"

           SET DIR("B")="Y"

           DO ^DIR

 +8        IF $DATA(DIRUT)

               QUIT 

           IF Y=0

               DO END

               QUIT 

 +9        FOR A=1:1:NUM

               SET FHC=$PIECE(FHCLST,",",A)

               IF FHC=""

                   QUIT 

               SET FHCDT=FHLIST(FHC)

               DO CAN

               DO CNSM100^FHOMRC2

 +10       WRITE "  ... done"

           QUIT 

 +11       QUIT 

CAN       ;

 +1        SET FHSTAT="C"

 +2        SET DA=$PIECE(FHCDT,U,2)

           SET FHDA=DA

           SET DA(1)=$PIECE(FHCDT,U,1)

           SET FHDFN=DA(1)

 +3        IF FHORN=""

               SET FHORN=$PIECE($GET(^FHPT(FHDFN,"SM",FHDA,0)),U,12)

 +4        IF '$DATA(^FHPT(DA(1),"SM",DA,0))

               QUIT 

 +5        SET DIE="^FHPT("_DA(1)_",""SM"","

 +6        SET DR="1////^S X=FHSTAT;14////^S X=FHORN;11.5////^S X=FHSTAT"

           DO ^DIE

 +7        SET FHZN=$GET(^FHPT(FHDFN,"SM",FHDA,0))

 +8        SET FHACT="C"

           SET FHOPTY="S"

           SET FHOPDT=FHDA

           DO SETSM^FHOMRO2

 +9        QUIT 

END       ;

 +1        KILL FHS,FHSTAT

           QUIT