- FHOMRE1 ;Hines OIFO/RTK-OUTPATIENT MEALS EARLY/LATE TRAY ;5/20/03 08:35
- ;;5.5;DIETETICS;**2,11**;Jan 28, 2005;Build 4
- ;
- ;09/08/2006 KAM/BAY Remedy Call 149576 - Add check for provide bagged meal
- ;
- S FHMSG1="E" D EN1,END Q
- EN1 D GETOPT^FHOMUTL I FHFIND=0 Q
- K NUM D DISP^FHOMRR1 I $G(NUM)="" Q
- EL1 K DIR S DIR(0)="NAO^1:"_NUM,DIR("A")="Early/Late Tray For Which Order? "
- D ^DIR Q:$D(DIRUT)
- S FHRMSEL=Y,FHC=FHRMSEL,FHRNUM=$P(FHLIST(FHRMSEL),U,1)
- S FHRMDT=$P(FHLIST(FHRMSEL),U,2),Y=FHRMDT D DD^%DT W !,Y,!
- I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" W !!?3,"The selected order has been cancelled!",! D EL1 Q
- I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) W !,"Early/Late Tray already exists for this meal." K DIR S DIR(0)="YA",DIR("A")="Do you wish to overwrite? ",DIR("B")="N" D ^DIR Q:$D(DIRUT) Q:Y'=1
- ; Only allow selection of one order at a time, rather than a range
- ; because they could be different meals which could have different
- ; allowable meal window times.
- K DIR S DIR(0)="SAO^E:EARLY;L:LATE",DIR("A")="Early or Late (E or L)? "
- D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
- S FHEL=Y
- ORD S FHLOC=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,3),FHORN="",FHMSG1="E"
- S FHDIET=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,2)
- S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8),FHCOMM1=$G(^FH(119.73,FHCOMM,1))
- S FHMEAL=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)
- S FH1=$S(FHMEAL="B":1,FHMEAL="N":7,1:13) I FHEL="L" S FH1=FH1+3
- TIME S FH3=FH1+2,FHCNT=0 F FHT=FH1:1:FH3 D
- .I $P(FHCOMM1,U,FHT)="" Q
- .S FHCNT=FHCNT+1,FHTM(FHCNT)=$P(FHCOMM1,U,FHT)
- W !,"Select Time: ( " F J=1:1:FHCNT W J,"=",FHTM(J)," "
- R ") ",FHS:DTIME I FHS=""!(FHS["^") D EXMSG^FHOMUTL Q
- I (FHS'?1N)!(FHS<1)!(FHS>FHCNT) W !!,"Invalid time selection!" D TIME Q
- S FHTIME=FHTM(FHS),X=FHRMDT_"@"_FHTIME,%DT="XT" D ^%DT S FHDTM=Y
- D NOW^%DTC I FHDTM<% W !!,"Cannot order for a Date/Time before now!" D TIME Q
- ;09/08/2006 KAM/BAY Rem Call 149576 Check file 119.73 PROVIDE BAGGED MEAL
- ;
- S FHBAG="N" I $P($G(^FH(119.73,FHCOMM,2)),U,10)="Y" D
- . K DIR S DIR(0)="SAO^Y:Yes;N:No",DIR("A")="Bagged Meal? ",DIR("B")="N"
- . D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
- . S FHBAG=Y
- D SET,UPD100,OKMSG^FHOMUTL,END Q
- ;
- SET S DA=FHRNUM,DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
- S FHORN=$S($G(FHORN)="":"",1:FHORN)
- D NOW^%DTC S FHTODAY=$E(%,1,12)
- S DR="14////^S X=FHTIME;15////^S X=FHBAG;16////^S X=DUZ;17////^S X=FHTODAY;17.5////^S X=FHORN;17.6////^S X=""@""" D ^DIE
- S FHACT="O",FHOPTY="E",FHAET=FHTIME D SETAET^FHOMRO2
- Q
- END K A,FHFIND,FHCLST,FHC,FHCOMM,FH1,FH3,FHTEXT,NUM
- K FHSEL,FHT,FHCNT,FHCOMM1,FHS Q
- Q
- HL7SET ;
- ; Entry point for E/L trays placed from CPRS/OERR
- S (FHRFLG,FHSFLG)=0,FHMEAL=$E(FHSVCP,1),FILL=""
- S FHEL=$E(FHSVCP,2),FHTM=$E(FHSVCP,3)
- I FHEL'?1"E",FHEL'?1"L" S TXT="Missing E/L" D GETOR^FHWOR,ERR^FHOMWOR Q
- I FHTM<1!(FHTM>3) S TXT="Invalid time" D GETOR^FHWOR,ERR^FHOMWOR Q
- S FHRMDT=STDT,ENDT=FHRMDT_.9999
- S FH1=$S(FHMEAL="B":1,FHMEAL="N":7,1:13) I FHEL="L" S FH1=FH1+3
- S FH1=FH1+FHTM-1
- S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8),FHCOMM1=$G(^FH(119.73,FHCOMM,1))
- S FHTIME=$P(FHCOMM1,U,FH1),X1=STDT,X2=-1 D C^%DTC S STDT1=X
- RM ; Check recurring meals
- I '$D(^FHPT(FHDFN,"OP","B",FHRMDT)) D SM Q
- F FHRMDT=STDT1:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(FHRMDT>ENDT) F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0 D
- .Q:$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)'=FHMEAL
- .Q:$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C"
- .S FHRNUM1=FHRNUM,FHRFLG=1 D SET Q
- S FILL="E;"_$G(FHRNUM1)
- SM ; Check special meals
- F FHSMDT=STDT:0 S FHSMDT=$O(^FHPT(FHDFN,"SM",FHSMDT)) Q:FHSMDT'>0!(FHSMDT>ENDT) D SETELSM
- ;
- I FHRFLG=0,FHSFLG=0 D REJECT Q
- I FILL="" D REJECT Q
- D SEND^FHWOR
- Q
- SETELSM ; Set E/L for Special Meals
- Q:$P($G(^FHPT(FHDFN,"SM",FHSMDT,0)),U,9)'=FHMEAL
- S FHSFLG=1,DA=FHSMDT,DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""SM"","
- D NOW^%DTC S FHTODAY=$E(%,1,12)
- S FHORN=$S($G(FHORN)="":"",1:FHORN),FILL="G;"_FHSMDT
- S DR="8////^S X=FHTIME;9////^S X=FHBAG;10////^S X=DUZ;11////^S X=FHORN" D ^DIE
- S FHZN=$G(^FHPT(FHDFN,"SM",FHSMDT,0))
- S FHACT="O",FHOPTY="S",FHSTAT="",FHOPDT=FHTODAY D SETSM^FHOMRO2
- Q
- REJECT ; Reject if no recurring or special meals found
- S TXT="No Recurring or Special Meal ordered for this date/meal"
- D GETOR^FHWOR,ERR^FHOMWOR Q
- Q
- UPD100 ;Backdoor message to update file #100 with a new EL order
- Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
- Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
- S FILL="E;"_FHRNUM,FHODT=$$FMTHL7^XLFDT(FHRMDT)
- S FHOMELN=FHMEAL_FHEL_FHS,FHOBAG="" I FHBAG="Y" S FHOBAG="bagged"
- S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHTODAY
- S MSG(5)="ODT|"_$S(FHEL="E":"EARLY",1:"LATE")_"|^^^"_FHOMELN_"^^99FHD|"_FHOBAG
- D EVSEND^FHWOR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMRE1 4831 printed Jan 18, 2025@02:54:09 Page 2
- FHOMRE1 ;Hines OIFO/RTK-OUTPATIENT MEALS EARLY/LATE TRAY ;5/20/03 08:35
- +1 ;;5.5;DIETETICS;**2,11**;Jan 28, 2005;Build 4
- +2 ;
- +3 ;09/08/2006 KAM/BAY Remedy Call 149576 - Add check for provide bagged meal
- +4 ;
- +5 SET FHMSG1="E"
- DO EN1
- DO END
- QUIT
- EN1 DO GETOPT^FHOMUTL
- IF FHFIND=0
- QUIT
- +1 KILL NUM
- DO DISP^FHOMRR1
- IF $GET(NUM)=""
- QUIT
- EL1 KILL DIR
- SET DIR(0)="NAO^1:"_NUM
- SET DIR("A")="Early/Late Tray For Which Order? "
- +1 DO ^DIR
- if $DATA(DIRUT)
- QUIT
- +2 SET FHRMSEL=Y
- SET FHC=FHRMSEL
- SET FHRNUM=$PIECE(FHLIST(FHRMSEL),U,1)
- +3 SET FHRMDT=$PIECE(FHLIST(FHRMSEL),U,2)
- SET Y=FHRMDT
- DO DD^%DT
- WRITE !,Y,!
- +4 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C"
- WRITE !!?3,"The selected order has been cancelled!",!
- DO EL1
- QUIT
- +5 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,2))
- WRITE !,"Early/Late Tray already exists for this meal."
- KILL DIR
- SET DIR(0)="YA"
- SET DIR("A")="Do you wish to overwrite? "
- SET DIR("B")="N"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- if Y'=1
- QUIT
- +6 ; Only allow selection of one order at a time, rather than a range
- +7 ; because they could be different meals which could have different
- +8 ; allowable meal window times.
- +9 KILL DIR
- SET DIR(0)="SAO^E:EARLY;L:LATE"
- SET DIR("A")="Early or Late (E or L)? "
- +10 DO ^DIR
- IF $DATA(DIRUT)
- DO EXMSG^FHOMUTL
- QUIT
- +11 SET FHEL=Y
- ORD SET FHLOC=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,3)
- SET FHORN=""
- SET FHMSG1="E"
- +1 SET FHDIET=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,2)
- +2 SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
- SET FHCOMM1=$GET(^FH(119.73,FHCOMM,1))
- +3 SET FHMEAL=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)
- +4 SET FH1=$SELECT(FHMEAL="B":1,FHMEAL="N":7,1:13)
- IF FHEL="L"
- SET FH1=FH1+3
- TIME SET FH3=FH1+2
- SET FHCNT=0
- FOR FHT=FH1:1:FH3
- Begin DoDot:1
- +1 IF $PIECE(FHCOMM1,U,FHT)=""
- QUIT
- +2 SET FHCNT=FHCNT+1
- SET FHTM(FHCNT)=$PIECE(FHCOMM1,U,FHT)
- End DoDot:1
- +3 WRITE !,"Select Time: ( "
- FOR J=1:1:FHCNT
- WRITE J,"=",FHTM(J)," "
- +4 READ ") ",FHS:DTIME
- IF FHS=""!(FHS["^")
- DO EXMSG^FHOMUTL
- QUIT
- +5 IF (FHS'?1N)!(FHS<1)!(FHS>FHCNT)
- WRITE !!,"Invalid time selection!"
- DO TIME
- QUIT
- +6 SET FHTIME=FHTM(FHS)
- SET X=FHRMDT_"@"_FHTIME
- SET %DT="XT"
- DO ^%DT
- SET FHDTM=Y
- +7 DO NOW^%DTC
- IF FHDTM<%
- WRITE !!,"Cannot order for a Date/Time before now!"
- DO TIME
- QUIT
- +8 ;09/08/2006 KAM/BAY Rem Call 149576 Check file 119.73 PROVIDE BAGGED MEAL
- +9 ;
- +10 SET FHBAG="N"
- IF $PIECE($GET(^FH(119.73,FHCOMM,2)),U,10)="Y"
- Begin DoDot:1
- +11 KILL DIR
- SET DIR(0)="SAO^Y:Yes;N:No"
- SET DIR("A")="Bagged Meal? "
- SET DIR("B")="N"
- +12 DO ^DIR
- IF $DATA(DIRUT)
- DO EXMSG^FHOMUTL
- QUIT
- +13 SET FHBAG=Y
- End DoDot:1
- +14 DO SET
- DO UPD100
- DO OKMSG^FHOMUTL
- DO END
- QUIT
- +15 ;
- SET SET DA=FHRNUM
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""OP"","
- +1 SET FHORN=$SELECT($GET(FHORN)="":"",1:FHORN)
- +2 DO NOW^%DTC
- SET FHTODAY=$EXTRACT(%,1,12)
- +3 SET DR="14////^S X=FHTIME;15////^S X=FHBAG;16////^S X=DUZ;17////^S X=FHTODAY;17.5////^S X=FHORN;17.6////^S X=""@"""
- DO ^DIE
- +4 SET FHACT="O"
- SET FHOPTY="E"
- SET FHAET=FHTIME
- DO SETAET^FHOMRO2
- +5 QUIT
- END KILL A,FHFIND,FHCLST,FHC,FHCOMM,FH1,FH3,FHTEXT,NUM
- +1 KILL FHSEL,FHT,FHCNT,FHCOMM1,FHS
- QUIT
- +2 QUIT
- HL7SET ;
- +1 ; Entry point for E/L trays placed from CPRS/OERR
- +2 SET (FHRFLG,FHSFLG)=0
- SET FHMEAL=$EXTRACT(FHSVCP,1)
- SET FILL=""
- +3 SET FHEL=$EXTRACT(FHSVCP,2)
- SET FHTM=$EXTRACT(FHSVCP,3)
- +4 IF FHEL'?1"E"
- IF FHEL'?1"L"
- SET TXT="Missing E/L"
- DO GETOR^FHWOR
- DO ERR^FHOMWOR
- QUIT
- +5 IF FHTM<1!(FHTM>3)
- SET TXT="Invalid time"
- DO GETOR^FHWOR
- DO ERR^FHOMWOR
- QUIT
- +6 SET FHRMDT=STDT
- SET ENDT=FHRMDT_.9999
- +7 SET FH1=$SELECT(FHMEAL="B":1,FHMEAL="N":7,1:13)
- IF FHEL="L"
- SET FH1=FH1+3
- +8 SET FH1=FH1+FHTM-1
- +9 SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
- SET FHCOMM1=$GET(^FH(119.73,FHCOMM,1))
- +10 SET FHTIME=$PIECE(FHCOMM1,U,FH1)
- SET X1=STDT
- SET X2=-1
- DO C^%DTC
- SET STDT1=X
- RM ; Check recurring meals
- +1 IF '$DATA(^FHPT(FHDFN,"OP","B",FHRMDT))
- DO SM
- QUIT
- +2 FOR FHRMDT=STDT1:0
- SET FHRMDT=$ORDER(^FHPT(FHDFN,"OP","B",FHRMDT))
- if FHRMDT'>0!(FHRMDT>ENDT)
- QUIT
- FOR FHRNUM=0:0
- SET FHRNUM=$ORDER(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM))
- if FHRNUM'>0
- QUIT
- Begin DoDot:1
- +3 if $PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)'=FHMEAL
- QUIT
- +4 if $PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C"
- QUIT
- +5 SET FHRNUM1=FHRNUM
- SET FHRFLG=1
- DO SET
- QUIT
- End DoDot:1
- +6 SET FILL="E;"_$GET(FHRNUM1)
- SM ; Check special meals
- +1 FOR FHSMDT=STDT:0
- SET FHSMDT=$ORDER(^FHPT(FHDFN,"SM",FHSMDT))
- if FHSMDT'>0!(FHSMDT>ENDT)
- QUIT
- DO SETELSM
- +2 ;
- +3 IF FHRFLG=0
- IF FHSFLG=0
- DO REJECT
- QUIT
- +4 IF FILL=""
- DO REJECT
- QUIT
- +5 DO SEND^FHWOR
- +6 QUIT
- SETELSM ; Set E/L for Special Meals
- +1 if $PIECE($GET(^FHPT(FHDFN,"SM",FHSMDT,0)),U,9)'=FHMEAL
- QUIT
- +2 SET FHSFLG=1
- SET DA=FHSMDT
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""SM"","
- +3 DO NOW^%DTC
- SET FHTODAY=$EXTRACT(%,1,12)
- +4 SET FHORN=$SELECT($GET(FHORN)="":"",1:FHORN)
- SET FILL="G;"_FHSMDT
- +5 SET DR="8////^S X=FHTIME;9////^S X=FHBAG;10////^S X=DUZ;11////^S X=FHORN"
- DO ^DIE
- +6 SET FHZN=$GET(^FHPT(FHDFN,"SM",FHSMDT,0))
- +7 SET FHACT="O"
- SET FHOPTY="S"
- SET FHSTAT=""
- SET FHOPDT=FHTODAY
- DO SETSM^FHOMRO2
- +8 QUIT
- REJECT ; Reject if no recurring or special meals found
- +1 SET TXT="No Recurring or Special Meal ordered for this date/meal"
- +2 DO GETOR^FHWOR
- DO ERR^FHOMWOR
- QUIT
- +3 QUIT
- UPD100 ;Backdoor message to update file #100 with a new EL order
- +1 ;must have CPRSv26 for O.M. backdoor
- if '$$PATCH^XPDUTL("OR*3.0*215")
- QUIT
- +2 ;Sets MSG(1), MSG(2) & MSG(3) for OM
- if 'DFN
- QUIT
- KILL MSG
- DO MSHOM^FHOMUTL
- +3 SET FILL="E;"_FHRNUM
- SET FHODT=$$FMTHL7^XLFDT(FHRMDT)
- +4 SET FHOMELN=FHMEAL_FHEL_FHS
- SET FHOBAG=""
- IF FHBAG="Y"
- SET FHOBAG="bagged"
- +5 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHTODAY
- +6 SET MSG(5)="ODT|"_$SELECT(FHEL="E":"EARLY",1:"LATE")_"|^^^"_FHOMELN_"^^99FHD|"_FHOBAG
- +7 DO EVSEND^FHWOR
- +8 QUIT