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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMSC1 910 printed Oct 16, 2024@17:53:56 Page 2
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
