source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHOMSC1.m@ 1133

Last change on this file since 1133 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 886 bytes
RevLine 
[613]1FHOMSC1 ;Hines OIFO/RTK SPECIAL MEALS CANCEL MEAL ;4/15/03 8:55
2 ;;5.5;DIETETICS;**2**;Jan 28, 2005
3 ;
4 S FHORN="",STDT=DT,FHS="ADP" D LIST^FHOMSS1 W !
5 I NUM=0 W !,"NO SPECIAL MEALS TO CANCEL" Q
6 K DIR S DIR("A")="Cancel Which Meal(s)?",DIR(0)="LO^1:"_NUM D ^DIR
7 Q:$D(DIRUT) S FHCLST=Y
8 W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
9 Q:$D(DIRUT) I Y=0 D END Q
10 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHCDT=FHLIST(FHC) D CAN,CNSM100^FHOMRC2
11 W " ... done" Q
12 Q
13CAN ;
14 S FHSTAT="C"
15 S DA=$P(FHCDT,U,2),FHDA=DA,DA(1)=$P(FHCDT,U,1),FHDFN=DA(1)
16 I FHORN="" S FHORN=$P($G(^FHPT(FHDFN,"SM",FHDA,0)),U,12)
17 I '$D(^FHPT(DA(1),"SM",DA,0)) Q
18 S DIE="^FHPT("_DA(1)_",""SM"","
19 S DR="1////^S X=FHSTAT;14////^S X=FHORN;11.5////^S X=FHSTAT" D ^DIE
20 S FHZN=$G(^FHPT(FHDFN,"SM",FHDA,0))
21 S FHACT="C",FHOPTY="S",FHOPDT=FHDA D SETSM^FHOMRO2
22 Q
23END ;
24 K FHS,FHSTAT Q
Note: See TracBrowser for help on using the repository browser.