- 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 Jan 18, 2025@02:54:07 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