FHOMWOR1.m

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

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