78 lines
3.3 KiB
Mathematica
78 lines
3.3 KiB
Mathematica
FHOMRC1 ;Hines OIFO/RTK RECURRING MEALS CANCEL MEAL ;2/10/03 15:05
|
|
;;5.5;DIETETICS;**2,8**;Jan 28, 2005;Build 28
|
|
;
|
|
CRM ; Cancel entire recurring meal
|
|
D GETRM Q:FHFIND=0 Q:$G(NUM)<1
|
|
CRM1 W ! K DIR S DIR("A")="Cancel which order (or ALL)?",DIR(0)="FO^1:80"
|
|
D ^DIR
|
|
Q:$D(DIRUT) S FHNUM=Y D RANGE^FHOMUTL I FHCLST="" D CRM1 Q
|
|
W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
|
|
I Y=0!($D(DIRUT)) D END Q
|
|
F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=$P(FHLIST(FHC),U,1) D CANRM,CNRM100^FHOMRC2
|
|
W " ... done" D END Q
|
|
CANRM ;
|
|
I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" Q
|
|
I $G(FHORN)="" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,12)
|
|
K DIE S FHSTAT="C",DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=FHRNUM
|
|
S DR="24////^S X=FHSTAT;.05////^S X=FHORN" D ^DIE
|
|
S FHACT="C",FHOPTY="R" D SETAET^FHOMRO2
|
|
Q
|
|
CA ; Cancel Additional Order
|
|
D GETRM Q:FHFIND=0 Q:$G(NUM)<1
|
|
CA1 W ! K DIR S DIR("A")="Cancel which Additional Order (or ALL)?"
|
|
S DIR(0)="FO^1:80" D ^DIR
|
|
Q:$D(DIRUT) S FHNUM=Y D RANGE^FHOMUTL I FHCLST="" D CA1 Q
|
|
W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
|
|
I Y=0!($D(DIRUT)) D END Q
|
|
F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=$P(FHLIST(FHC),U,1) D CANAO,CNAO100^FHOMRC2
|
|
W " ... done" D END Q
|
|
CANAO ;
|
|
I '$D(^FHPT(FHDFN,"OP",FHRNUM,1)) Q
|
|
I $P($G(^FHPT(FHDFN,"OP",FHRNUM,1)),U,5)="C" Q
|
|
I $G(FHORN)="" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,1)),U,4)
|
|
K DIE S FHSTAT="C",DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=FHRNUM
|
|
S DR="13.6////^S X=FHSTAT;13.5////^S X=FHORN" D ^DIE
|
|
S FHACT="C",FHOPTY="A" D SETAET^FHOMRO2 S FHORN=""
|
|
Q
|
|
CE ; Cancel Early/Late Tray
|
|
D GETRM Q:FHFIND=0 Q:$G(NUM)<1
|
|
CE1 W ! K DIR S DIR("A")="Cancel which Early/Late Tray (or ALL)?"
|
|
S DIR(0)="FO^1:80" D ^DIR
|
|
Q:$D(DIRUT) S FHNUM=Y D RANGE^FHOMUTL I FHCLST="" D CE1 Q
|
|
W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
|
|
I Y=0!($D(DIRUT)) D END Q
|
|
F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=$P(FHLIST(FHC),U,1) D CANEL,CNEL100^FHOMRC2
|
|
W " ... done" D END Q
|
|
CANEL ;
|
|
I '$D(^FHPT(FHDFN,"OP",FHRNUM,2)) Q
|
|
I $P($G(^FHPT(FHDFN,"OP",FHRNUM,2)),U,6)="C" Q
|
|
I $G(FHORN)="" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,2)),U,5)
|
|
K DIE S FHSTAT="C",DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=FHRNUM
|
|
S DR="17.6////^S X=FHSTAT;17.5////^S X=FHORN" D ^DIE
|
|
S FHACT="C",FHOPTY="E" D SETAET^FHOMRO2 S FHORN=""
|
|
Q
|
|
CT ; Cancel Tubefeeding
|
|
D GETRM Q:FHFIND=0 Q:$G(NUM)<1
|
|
CT1 W ! K DIR S DIR("A")="Cancel which Tubefeeding (or ALL)?"
|
|
S DIR(0)="FO^1:80" D ^DIR
|
|
Q:$D(DIRUT) S FHNUM=Y D RANGE^FHOMUTL I FHCLST="" D CT1 Q
|
|
W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
|
|
I Y=0!($D(DIRUT)) D END Q
|
|
F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=$P(FHLIST(FHC),U,1) D CANTF,CNTF100^FHOMRC2
|
|
W " ... done" D END Q
|
|
CANTF ;
|
|
I '$D(^FHPT(FHDFN,"OP",FHRNUM,3)) Q
|
|
I $P($G(^FHPT(FHDFN,"OP",FHRNUM,3)),U,5)="C" Q
|
|
I $G(FHORN)="" S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,3)),U,4)
|
|
K DIE S FHSTAT="C",DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=FHRNUM
|
|
S DR="21.6////^S X=FHSTAT;21.5////^S X=FHORN" D ^DIE
|
|
S FHACT="C",FHOPTY="T" D SETAET^FHOMRO2 S FHORN=""
|
|
Q
|
|
GETRM ; Select patient and get recurring meals
|
|
S FHORN="",FHPSDT="N" D GETOPT^FHOMUTL I FHFIND=0 Q
|
|
K NUM D DISP^FHOMRR1 I $G(NUM)="" Q
|
|
K FHPSDT Q
|
|
END ;
|
|
K A,FHFIND,FHCLST,FHC,FHCDT,FHPSDT,NUM
|
|
Q
|