source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHOMRC1.m@ 1474

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1FHOMRC1 ;Hines OIFO/RTK RECURRING MEALS CANCEL MEAL ;2/10/03 15:05
2 ;;5.5;DIETETICS;**2,8**;Jan 28, 2005;Build 28
3 ;
4CRM ; Cancel entire recurring meal
5 D GETRM Q:FHFIND=0 Q:$G(NUM)<1
6CRM1 W ! K DIR S DIR("A")="Cancel which order (or ALL)?",DIR(0)="FO^1:80"
7 D ^DIR
8 Q:$D(DIRUT) S FHNUM=Y D RANGE^FHOMUTL I FHCLST="" D CRM1 Q
9 W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
10 I Y=0!($D(DIRUT)) D END Q
11 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=$P(FHLIST(FHC),U,1) D CANRM,CNRM100^FHOMRC2
12 W " ... done" D END Q
13CANRM ;
14 I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" Q
15 I $G(FHORN)="" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,12)
16 K DIE S FHSTAT="C",DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=FHRNUM
17 S DR="24////^S X=FHSTAT;.05////^S X=FHORN" D ^DIE
18 S FHACT="C",FHOPTY="R" D SETAET^FHOMRO2
19 Q
20CA ; Cancel Additional Order
21 D GETRM Q:FHFIND=0 Q:$G(NUM)<1
22CA1 W ! K DIR S DIR("A")="Cancel which Additional Order (or ALL)?"
23 S DIR(0)="FO^1:80" D ^DIR
24 Q:$D(DIRUT) S FHNUM=Y D RANGE^FHOMUTL I FHCLST="" D CA1 Q
25 W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
26 I Y=0!($D(DIRUT)) D END Q
27 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=$P(FHLIST(FHC),U,1) D CANAO,CNAO100^FHOMRC2
28 W " ... done" D END Q
29CANAO ;
30 I '$D(^FHPT(FHDFN,"OP",FHRNUM,1)) Q
31 I $P($G(^FHPT(FHDFN,"OP",FHRNUM,1)),U,5)="C" Q
32 I $G(FHORN)="" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,1)),U,4)
33 K DIE S FHSTAT="C",DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=FHRNUM
34 S DR="13.6////^S X=FHSTAT;13.5////^S X=FHORN" D ^DIE
35 S FHACT="C",FHOPTY="A" D SETAET^FHOMRO2 S FHORN=""
36 Q
37CE ; Cancel Early/Late Tray
38 D GETRM Q:FHFIND=0 Q:$G(NUM)<1
39CE1 W ! K DIR S DIR("A")="Cancel which Early/Late Tray (or ALL)?"
40 S DIR(0)="FO^1:80" D ^DIR
41 Q:$D(DIRUT) S FHNUM=Y D RANGE^FHOMUTL I FHCLST="" D CE1 Q
42 W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
43 I Y=0!($D(DIRUT)) D END Q
44 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=$P(FHLIST(FHC),U,1) D CANEL,CNEL100^FHOMRC2
45 W " ... done" D END Q
46CANEL ;
47 I '$D(^FHPT(FHDFN,"OP",FHRNUM,2)) Q
48 I $P($G(^FHPT(FHDFN,"OP",FHRNUM,2)),U,6)="C" Q
49 I $G(FHORN)="" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,2)),U,5)
50 K DIE S FHSTAT="C",DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=FHRNUM
51 S DR="17.6////^S X=FHSTAT;17.5////^S X=FHORN" D ^DIE
52 S FHACT="C",FHOPTY="E" D SETAET^FHOMRO2 S FHORN=""
53 Q
54CT ; Cancel Tubefeeding
55 D GETRM Q:FHFIND=0 Q:$G(NUM)<1
56CT1 W ! K DIR S DIR("A")="Cancel which Tubefeeding (or ALL)?"
57 S DIR(0)="FO^1:80" D ^DIR
58 Q:$D(DIRUT) S FHNUM=Y D RANGE^FHOMUTL I FHCLST="" D CT1 Q
59 W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
60 I Y=0!($D(DIRUT)) D END Q
61 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=$P(FHLIST(FHC),U,1) D CANTF,CNTF100^FHOMRC2
62 W " ... done" D END Q
63CANTF ;
64 I '$D(^FHPT(FHDFN,"OP",FHRNUM,3)) Q
65 I $P($G(^FHPT(FHDFN,"OP",FHRNUM,3)),U,5)="C" Q
66 I $G(FHORN)="" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,3)),U,4)
67 K DIE S FHSTAT="C",DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=FHRNUM
68 S DR="21.6////^S X=FHSTAT;21.5////^S X=FHORN" D ^DIE
69 S FHACT="C",FHOPTY="T" D SETAET^FHOMRO2 S FHORN=""
70 Q
71GETRM ; Select patient and get recurring meals
72 S FHORN="",FHPSDT="N" D GETOPT^FHOMUTL I FHFIND=0 Q
73 K NUM D DISP^FHOMRR1 I $G(NUM)="" Q
74 K FHPSDT Q
75END ;
76 K A,FHFIND,FHCLST,FHC,FHCDT,FHPSDT,NUM
77 Q
Note: See TracBrowser for help on using the repository browser.