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 Dec 13, 2024@01:53:15 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
