Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHOMSC1

FHOMSC1.m

Go to the documentation of this file.
  1. FHOMSC1 ;Hines OIFO/RTK SPECIAL MEALS CANCEL MEAL ;4/15/03 8:55
  1. ;;5.5;DIETETICS;**2**;Jan 28, 2005
  1. ;
  1. S FHORN="",STDT=DT,FHS="ADP" D LIST^FHOMSS1 W !
  1. I NUM=0 W !,"NO SPECIAL MEALS TO CANCEL" Q
  1. K DIR S DIR("A")="Cancel Which Meal(s)?",DIR(0)="LO^1:"_NUM D ^DIR
  1. Q:$D(DIRUT) S FHCLST=Y
  1. W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
  1. Q:$D(DIRUT) I Y=0 D END Q
  1. F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHCDT=FHLIST(FHC) D CAN,CNSM100^FHOMRC2
  1. W " ... done" Q
  1. Q
  1. CAN ;
  1. S FHSTAT="C"
  1. S DA=$P(FHCDT,U,2),FHDA=DA,DA(1)=$P(FHCDT,U,1),FHDFN=DA(1)
  1. I FHORN="" S FHORN=$P($G(^FHPT(FHDFN,"SM",FHDA,0)),U,12)
  1. I '$D(^FHPT(DA(1),"SM",DA,0)) Q
  1. S DIE="^FHPT("_DA(1)_",""SM"","
  1. S DR="1////^S X=FHSTAT;14////^S X=FHORN;11.5////^S X=FHSTAT" D ^DIE
  1. S FHZN=$G(^FHPT(FHDFN,"SM",FHDA,0))
  1. S FHACT="C",FHOPTY="S",FHOPDT=FHDA D SETSM^FHOMRO2
  1. Q
  1. END ;
  1. K FHS,FHSTAT Q