- FHOMWOR1 ;Hines OIFO/RTK OUTPATIENT MEALS/HL7 MSGING CONT ;04/22/05 9:15
- ;;5.5;DIETETICS;**2**;Jan 28, 2005
- ;
- NA ;Number assign for outpatient meals orders (store OR# in FH field)
- I FHTYPE="A" D NAAO Q
- I FHTYPE="E" D NAEL Q
- I FHTYPE="T" D NATF Q
- I FHTYPE="R" D NARM Q
- I FHTYPE="I" D NAIP Q
- I FHTYPE="S" S FHSN=+FHRNUM D NASM Q
- I FHTYPE="G" S FHSN=+FHRNUM D NASMEL Q
- I FHTYPE="RMEDIT" D NARMED Q
- S TXT="BAD TYPE" D GETOR^FHWOR,ERR^FHOMWOR Q
- Q
- NAAO ;
- K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
- S DA=+FHRNUM,DR="13.5////^S X=FHORN" D ^DIE
- Q
- NAEL ;
- K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
- S DA=+FHRNUM,DR="17.5////^S X=FHORN" D ^DIE
- Q
- NATF ;
- K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
- S DA=+FHRNUM,DR="21.5////^S X=FHORN" D ^DIE
- Q
- NARM ;
- F FHRNM=0:0 S FHRNM=$O(^FHPT(FHDFN,"OP","C",FHMPN,FHRNM)) Q:FHRNM'>0 D
- .K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
- .S DA=FHRNM,DR=".05////^S X=FHORN" D ^DIE
- .Q
- Q
- NAIP ;
- K DIE S DIE="^FHPT(",DA=FHDFN,DR="20////^S X=FHORN" D ^DIE
- Q
- NASM ;
- K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""SM"","
- S DA=FHSN,DR="14////^S X=FHORN" D ^DIE
- Q
- NASMEL ;
- K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""SM"","
- S DA=FHSN,DR="11////^S X=FHORN" D ^DIE
- Q
- NARMED ;
- K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
- S DA=+FHRNUM,DR=".05////^S X=FHORN" D ^DIE
- Q
- OMD1IT ;
- F PIECE=3,4,5,6 S $P(^FH(119.9,1,0),U,PIECE)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMWOR1 1448 printed Jan 18, 2025@02:54:28 Page 2
- FHOMWOR1 ;Hines OIFO/RTK OUTPATIENT MEALS/HL7 MSGING CONT ;04/22/05 9:15
- +1 ;;5.5;DIETETICS;**2**;Jan 28, 2005
- +2 ;
- NA ;Number assign for outpatient meals orders (store OR# in FH field)
- +1 IF FHTYPE="A"
- DO NAAO
- QUIT
- +2 IF FHTYPE="E"
- DO NAEL
- QUIT
- +3 IF FHTYPE="T"
- DO NATF
- QUIT
- +4 IF FHTYPE="R"
- DO NARM
- QUIT
- +5 IF FHTYPE="I"
- DO NAIP
- QUIT
- +6 IF FHTYPE="S"
- SET FHSN=+FHRNUM
- DO NASM
- QUIT
- +7 IF FHTYPE="G"
- SET FHSN=+FHRNUM
- DO NASMEL
- QUIT
- +8 IF FHTYPE="RMEDIT"
- DO NARMED
- QUIT
- +9 SET TXT="BAD TYPE"
- DO GETOR^FHWOR
- DO ERR^FHOMWOR
- QUIT
- +10 QUIT
- NAAO ;
- +1 KILL DIE
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""OP"","
- +2 SET DA=+FHRNUM
- SET DR="13.5////^S X=FHORN"
- DO ^DIE
- +3 QUIT
- NAEL ;
- +1 KILL DIE
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""OP"","
- +2 SET DA=+FHRNUM
- SET DR="17.5////^S X=FHORN"
- DO ^DIE
- +3 QUIT
- NATF ;
- +1 KILL DIE
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""OP"","
- +2 SET DA=+FHRNUM
- SET DR="21.5////^S X=FHORN"
- DO ^DIE
- +3 QUIT
- NARM ;
- +1 FOR FHRNM=0:0
- SET FHRNM=$ORDER(^FHPT(FHDFN,"OP","C",FHMPN,FHRNM))
- if FHRNM'>0
- QUIT
- Begin DoDot:1
- +2 KILL DIE
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""OP"","
- +3 SET DA=FHRNM
- SET DR=".05////^S X=FHORN"
- DO ^DIE
- +4 QUIT
- End DoDot:1
- +5 QUIT
- NAIP ;
- +1 KILL DIE
- SET DIE="^FHPT("
- SET DA=FHDFN
- SET DR="20////^S X=FHORN"
- DO ^DIE
- +2 QUIT
- NASM ;
- +1 KILL DIE
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""SM"","
- +2 SET DA=FHSN
- SET DR="14////^S X=FHORN"
- DO ^DIE
- +3 QUIT
- NASMEL ;
- +1 KILL DIE
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""SM"","
- +2 SET DA=FHSN
- SET DR="11////^S X=FHORN"
- DO ^DIE
- +3 QUIT
- NARMED ;
- +1 KILL DIE
- SET DA(1)=FHDFN
- SET DIE="^FHPT("_DA(1)_",""OP"","
- +2 SET DA=+FHRNUM
- SET DR=".05////^S X=FHORN"
- DO ^DIE
- +3 QUIT
- OMD1IT ;
- +1 FOR PIECE=3,4,5,6
- SET $PIECE(^FH(119.9,1,0),U,PIECE)=""
- +2 QUIT