- 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 Jan 18, 2025@02:54:18 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