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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMRC1 3424 printed Dec 13, 2024@01:52:54 Page 2
FHOMRC1 ;Hines OIFO/RTK RECURRING MEALS CANCEL MEAL ;2/10/03 15:05
+1 ;;5.5;DIETETICS;**2,8**;Jan 28, 2005;Build 28
+2 ;
CRM ; Cancel entire recurring meal
+1 DO GETRM
if FHFIND=0
QUIT
if $GET(NUM)<1
QUIT
CRM1 WRITE !
KILL DIR
SET DIR("A")="Cancel which order (or ALL)?"
SET DIR(0)="FO^1:80"
+1 DO ^DIR
+2 if $DATA(DIRUT)
QUIT
SET FHNUM=Y
DO RANGE^FHOMUTL
IF FHCLST=""
DO CRM1
QUIT
+3 WRITE !
KILL DIR
SET DIR("A")="Are you sure? "
SET DIR(0)="YA"
SET DIR("B")="Y"
DO ^DIR
+4 IF Y=0!($DATA(DIRUT))
DO END
QUIT
+5 FOR A=1:1:NUM
SET FHC=$PIECE(FHCLST,",",A)
if FHC=""
QUIT
SET FHRNUM=$PIECE(FHLIST(FHC),U,1)
DO CANRM
DO CNRM100^FHOMRC2
+6 WRITE " ... done"
DO END
QUIT
CANRM ;
+1 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C"
QUIT
+2 IF $GET(FHORN)=""
SET FHORN=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,12)
+3 KILL DIE
SET FHSTAT="C"
SET DA(1)=FHDFN
SET DIE="^FHPT("_DA(1)_",""OP"","
SET DA=FHRNUM
+4 SET DR="24////^S X=FHSTAT;.05////^S X=FHORN"
DO ^DIE
+5 SET FHACT="C"
SET FHOPTY="R"
DO SETAET^FHOMRO2
+6 QUIT
CA ; Cancel Additional Order
+1 DO GETRM
if FHFIND=0
QUIT
if $GET(NUM)<1
QUIT
CA1 WRITE !
KILL DIR
SET DIR("A")="Cancel which Additional Order (or ALL)?"
+1 SET DIR(0)="FO^1:80"
DO ^DIR
+2 if $DATA(DIRUT)
QUIT
SET FHNUM=Y
DO RANGE^FHOMUTL
IF FHCLST=""
DO CA1
QUIT
+3 WRITE !
KILL DIR
SET DIR("A")="Are you sure? "
SET DIR(0)="YA"
SET DIR("B")="Y"
DO ^DIR
+4 IF Y=0!($DATA(DIRUT))
DO END
QUIT
+5 FOR A=1:1:NUM
SET FHC=$PIECE(FHCLST,",",A)
if FHC=""
QUIT
SET FHRNUM=$PIECE(FHLIST(FHC),U,1)
DO CANAO
DO CNAO100^FHOMRC2
+6 WRITE " ... done"
DO END
QUIT
CANAO ;
+1 IF '$DATA(^FHPT(FHDFN,"OP",FHRNUM,1))
QUIT
+2 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,1)),U,5)="C"
QUIT
+3 IF $GET(FHORN)=""
SET FHORN=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,1)),U,4)
+4 KILL DIE
SET FHSTAT="C"
SET DA(1)=FHDFN
SET DIE="^FHPT("_DA(1)_",""OP"","
SET DA=FHRNUM
+5 SET DR="13.6////^S X=FHSTAT;13.5////^S X=FHORN"
DO ^DIE
+6 SET FHACT="C"
SET FHOPTY="A"
DO SETAET^FHOMRO2
SET FHORN=""
+7 QUIT
CE ; Cancel Early/Late Tray
+1 DO GETRM
if FHFIND=0
QUIT
if $GET(NUM)<1
QUIT
CE1 WRITE !
KILL DIR
SET DIR("A")="Cancel which Early/Late Tray (or ALL)?"
+1 SET DIR(0)="FO^1:80"
DO ^DIR
+2 if $DATA(DIRUT)
QUIT
SET FHNUM=Y
DO RANGE^FHOMUTL
IF FHCLST=""
DO CE1
QUIT
+3 WRITE !
KILL DIR
SET DIR("A")="Are you sure? "
SET DIR(0)="YA"
SET DIR("B")="Y"
DO ^DIR
+4 IF Y=0!($DATA(DIRUT))
DO END
QUIT
+5 FOR A=1:1:NUM
SET FHC=$PIECE(FHCLST,",",A)
if FHC=""
QUIT
SET FHRNUM=$PIECE(FHLIST(FHC),U,1)
DO CANEL
DO CNEL100^FHOMRC2
+6 WRITE " ... done"
DO END
QUIT
CANEL ;
+1 IF '$DATA(^FHPT(FHDFN,"OP",FHRNUM,2))
QUIT
+2 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,2)),U,6)="C"
QUIT
+3 IF $GET(FHORN)=""
SET FHORN=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,2)),U,5)
+4 KILL DIE
SET FHSTAT="C"
SET DA(1)=FHDFN
SET DIE="^FHPT("_DA(1)_",""OP"","
SET DA=FHRNUM
+5 SET DR="17.6////^S X=FHSTAT;17.5////^S X=FHORN"
DO ^DIE
+6 SET FHACT="C"
SET FHOPTY="E"
DO SETAET^FHOMRO2
SET FHORN=""
+7 QUIT
CT ; Cancel Tubefeeding
+1 DO GETRM
if FHFIND=0
QUIT
if $GET(NUM)<1
QUIT
CT1 WRITE !
KILL DIR
SET DIR("A")="Cancel which Tubefeeding (or ALL)?"
+1 SET DIR(0)="FO^1:80"
DO ^DIR
+2 if $DATA(DIRUT)
QUIT
SET FHNUM=Y
DO RANGE^FHOMUTL
IF FHCLST=""
DO CT1
QUIT
+3 WRITE !
KILL DIR
SET DIR("A")="Are you sure? "
SET DIR(0)="YA"
SET DIR("B")="Y"
DO ^DIR
+4 IF Y=0!($DATA(DIRUT))
DO END
QUIT
+5 FOR A=1:1:NUM
SET FHC=$PIECE(FHCLST,",",A)
if FHC=""
QUIT
SET FHRNUM=$PIECE(FHLIST(FHC),U,1)
DO CANTF
DO CNTF100^FHOMRC2
+6 WRITE " ... done"
DO END
QUIT
CANTF ;
+1 IF '$DATA(^FHPT(FHDFN,"OP",FHRNUM,3))
QUIT
+2 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,3)),U,5)="C"
QUIT
+3 IF $GET(FHORN)=""
SET FHORN=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,3)),U,4)
+4 KILL DIE
SET FHSTAT="C"
SET DA(1)=FHDFN
SET DIE="^FHPT("_DA(1)_",""OP"","
SET DA=FHRNUM
+5 SET DR="21.6////^S X=FHSTAT;21.5////^S X=FHORN"
DO ^DIE
+6 SET FHACT="C"
SET FHOPTY="T"
DO SETAET^FHOMRO2
SET FHORN=""
+7 QUIT
GETRM ; Select patient and get recurring meals
+1 SET FHORN=""
SET FHPSDT="N"
DO GETOPT^FHOMUTL
IF FHFIND=0
QUIT
+2 KILL NUM
DO DISP^FHOMRR1
IF $GET(NUM)=""
QUIT
+3 KILL FHPSDT
QUIT
END ;
+1 KILL A,FHFIND,FHCLST,FHC,FHCDT,FHPSDT,NUM
+2 QUIT
