FHOMUTL.m

FHOMUTL ;Hines OIFO/RTK OUTPATIENT MEALS UTILITIES  ;2/04/03  15:15

 ;;5.5;DIETETICS;**1,2,5**;Jan 28, 2005;Build 53

 ;

DIV ;ask for Communication office if Multi-division.

 N FHSCNT,FH

 K FHSITE,FHSITENM

 S FHSCNT=0 F FH=0:0 S FH=$O(^FH(119.73,FH)) Q:FH'>0  S FHSCNT=FHSCNT+1,FHSITE=FH,FHSITENM=$P($G(^FH(119.73,FH,0)),U,1)

 I (FHSCNT=1),($P($G(^FH(119.9,1,0)),U,20)'="Y") Q

D2 I FHSCNT>1 K FHSITE,FHSITENM,X R !!,"Select COMMUNICATION OFFICE (or ALL): ALL// ",X:DTIME S:X="" X="ALL" Q:'$T!("^"[X)  D TR^FH I X="ALL" S FHSITE=0

 I X'="ALL" K DIC S DIC="^FH(119.73,",DIC(0)="EMQ" D ^DIC G:Y<1 D2 S FHSITE=+Y,FHSITENM=$P(Y,U,2)

 Q

 ;

STDATE ;Prompt for start date (if FHPSDT="N" do not allow past dates)

 S STDT="" D NOW^%DTC S Y=X D DD^%DT S FHDTDF=Y

 K DIR S DIR("A")="Select Start Date: ",DIR("B")=FHDTDF

 S DIR(0)="DAO" I $G(FHPSDT)="N" S DIR(0)="DAO^FHDTDF"

 D ^DIR Q:$D(DIRUT)  S STDT=Y S Y=STDT D DD^%DT W "  ",Y

 Q

ENDATE ;Prompt for end date

 S ENDT="" D NOW^%DTC S Y=X D DD^%DT S FHDTDF=Y K DIR

 S DIR("A")="Select End Date: ",DIR("B")=FHDTDF,DIR(0)="DAO^"_STDT D ^DIR

 Q:$D(DIRUT)  S ENDT=Y S Y=ENDT D DD^%DT W "  ",Y

 Q

OUTLOC ;Prompt for outpatient location - screen for ONLY Outpatient Locations

 S FHLOC="",FHOUT="O"

 K DIC S DIC="^FH(119.6,",DIC(0)="AEQZ"

 S DIC("A")="Select Outpatient Ordering Location: "

 S DIC("S")="I $P(^(0),U,3)=FHOUT" D ^DIC

 Q:$D(DUOUT)  I Y=-1 Q

 S FHLOC=+Y,FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8)

 I '$O(^FH(119.6,FHLOC,"L",0)) S FHLOC="",FHCOMM="" W !!,"The selected location does not have an Associated Hospital Location.  To set",!,"the Associated Hospital Location use option ENTER/EDIT NUTRITION LOCATIONS."

 Q

 ;

RMBED ;Prompt for outpatient room-bed - must be set up for Outpatient Location

 S (FHRMBD,FHRMBSL)=""

 I $G(FHLOC)="" W !!,"No OUTPATIENT LOCATION selected" Q

 I '$D(^FH(119.6,FHLOC,"R")) Q

 F FHRMBI=0:0 S FHRMBI=$O(^FH(119.6,FHLOC,"R",FHRMBI)) Q:FHRMBI'>0  D

 .S FHRMBPT=$P($G(^FH(119.6,FHLOC,"R",FHRMBI,0)),U),FHRMBSL(FHRMBPT)=1

 K DIC S DIC="^DG(405.4,",DIC(0)="AEQZ"

 S DIC("A")="Select Outpatient Room-Bed: "

 S DIC("S")="I $D(FHRMBSL(+Y))" D ^DIC

 Q:$D(DUOUT)  I Y=-1 Q

 S FHRMBD=+Y

 Q

GTFHDFN ;Get FHDFN, given DFN

 K DIR S DIR(0)="NAO",DIR("B")="ENTER DFN" D ^DIR Q:$D(DIRUT)  S ZZDFN=Y

 S FHZ115="P"_ZZDFN,FHDFN=$O(^FHPT("B",FHZ115,""))

 I '$D(^DPT(ZZDFN)) W !!,"DFN '",ZZDFN,"' NOT FOUND IN FILE 2",! Q

 I FHDFN="" W !!,"NO CORRESPONDING FHDFN"

 W !!," NAME: ",$P($G(^DPT(ZZDFN,0)),U,1)

 W !?2,"DFN: ",ZZDFN,!,"FHDFN: ",FHDFN,!

 Q

GETOPT ;Select outpatient for recurring meals

 S FHFIND=1 D ^FHOMDPA I FHDFN="" S FHFIND=0 Q

 I '$D(^FHPT(FHDFN,0)) S FHFIND=0 Q  ;W !!,"UNKNOWN SELECTION !"

 I $O(^FHPT(FHDFN,"OP",0))="" W !!,"NO RECURRING MEALS FOR THIS PERSON" S FHFIND=0 Q

 W ! D STDATE I STDT="" S FHFIND=0 Q

 Q

PATNAME ;Get name and demographics of patient/new person

 ;input variable: FHDFN

 S (FHDOB,FHBID,FHSEX,DFN)="" D GETZN

 I FILE="P" S FHPTNM=$P($G(^DPT(IEN,0)),U,1)

 I FILE="N" S FHPTNM=$P($G(^VA(200,IEN,0)),U,1)

 ;Get SSN,Age,DOB,Sex of patient/new person

 I FILE="P" D

 .S DFN=IEN

 .D PID^FHDPA S FHSSN=PID

 .S FHSEX=$P($G(^DPT(DFN,0)),U,2),FHDOB=$P($G(^DPT(DFN,0)),U,3)

 .S FHBID=BID

 I FILE="N" D

 .S IEN200=IEN,FHSSN=$P($G(^VA(200,IEN,1)),U,9)

 .S FHBID=$E(FHSSN,6,$L(FHSSN))

 .S FHSEX=$P($G(^VA(200,IEN,1)),U,2),FHDOB=$P($G(^VA(200,IEN,1)),U,3)

 S FHAGE="" D NOW^%DTC

 I FHDOB'="" S FHAGE=$E(%,1,3)-$E(FHDOB,1,3)-($E(%,4,7)<$E(FHDOB,4,7))

 Q

GETZN ;Get first piece of zero node in 115

 S FHPCZN=$P($G(^FHPT(FHDFN,0)),U,1),FILE=$E(FHPCZN,1)

 S IEN=$E(FHPCZN,2,99)

 Q

DIETVER ;Verify that diet selected is from the allowable diets in 119.9

 D DIETLST I $D(FHDIETS(FHDIET)) Q

 S FHDIET="" W *7," ==> NOT ALLOWED",! D DIETMSG Q

DIETHLP ;Display allowable diets from 119.9

 D DIETLST,DIETMSG Q

DIETLST ;Build list

 K FHDIETS,SPD S FHSPDTS="",SPD=$P($G(^FH(119.9,1,0)),U,2,6)_"^"_$P($G(^FH(119.9,1,1)),U,1,10)

 S FHDEF=$P($G(^FH(119.9,1,0)),U,2)

 F A=1:1:15 S AB=$P(SPD,U,A) D

 .I AB="" Q

 .S FHDIETS(AB)=AB

 .S FHSPDTS=FHSPDTS_$P($G(^FH(111,AB,0)),U,1)_"^"

 Q

DIETMSG ;Display message

 W !?3,"You must select from the diets set up in the Site Parameters:"

 S AB="" F  S AB=$O(FHDIETS(AB)) Q:AB'>0  W !?3,$P($G(^FH(111,AB,0)),U)

 W ! Q

 Q

EXMSG ;Display message stating meal NOT ordered

 D TYPE

 W !!?3,FHMSGML," NOT ordered!",! H 2

 Q

OKMSG ;Display message stating meal ordered successfully

 D TYPE

 D PATNAME W !!?3,FHMSGML," ordered for ",FHPTNM,"...",! H 2

 Q

TYPE ;

 S FHMSGML=$S(FHMSG1="G":"Guest meal",FHMSG1="S":"Special meal",FHMSG1="R":"Recurring meal",FHMSG1="E":"Early/Late tray",FHMSG1="T":"Tubefeeding",1:"Additional order")

 Q

UPXMSG ;

 W !!?3,"Recurring meal NOT updated! ",! H 2

 Q

UPDMSG ;

 D PATNAME W !!?3,"Recurring meal updated for ",FHPTNM,"...",! H 2

 Q

SMSTAT ;Status of last special meal request

 S FHSMNUM=$O(^FHPT(FHDFN,"SM","B",""),-1) I FHSMNUM="" S FHSTAT="" Q

 I $E(FHSMNUM,1,7)'=DT S FHSTAT="" Q

 S FHSTAT=$P($G(^FHPT(FHDFN,"SM",FHSMNUM,0)),U,2)

 Q

RANGE ;Check for validity of range of numbers entered

 S FHCLST="",FLG="",X=FHNUM D TR^FH S FHNUM=X

 I FHNUM="A"!(FHNUM?1"A"1.2"L") S FHNUM="1-"_NUM

 F K=1:1 S K1=$P(FHNUM,",",K) Q:K1=""!(FLG="QUIT")  D

 .S K2=$S(K1["-":$P(K1,"-",2),1:+K1),K1=+K1 D CK I FLG="QUIT" Q

 .F K3=K1:1:K2 S FHCLST=FHCLST_K3_","

 Q

CK I K1<1!(K1>NUM)!(K1'?1N.N) D C1 Q

 I K2<1!(K2>NUM)!(K2'?1N.N) D C1 Q

 Q:K2'<K1

C1 W !,"  Enter numbers or range or ALL (E.G.,  1,3,4 or 3-5 or 1,3-5)" S FLG="QUIT",FHCLST="" Q

 Q

MSHOM ;Code MSG for outpatient orders

 D SITE^FH

 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"

 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)

 S FHOLOC=$O(^FH(119.6,FHLOC,"L",0)) I FHOLOC="" Q  ;RESULTS IN NO BKDOOR

 S FHOLOC=$G(^FH(119.6,FHLOC,"L",FHOLOC,0))

 S FHOLOCNM=$P($G(^SC(FHOLOC,0)),U,1)

 S MSG(3)="PV1||O|"_FHOLOC_"^"_FHOLOCNM_"||||||||||||||||"

 Q

MSHCA ;Code Cancel/Discontinue for outpatient orders

 D NOW^%DTC S FHNOW=% K MSG S ACT="OC" D SITE^FH

 I $G(FHCATXT)="" S FHCATXT="Dietetics Canceled order."

 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"

 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)

 S DATE=$$FMTHL7^XLFDT(FHNOW)

 S MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_DUZ_"|||"_DATE_"|"_FHCATXT

 Q

MSHSS ;Code MSG for outpatient send status messages

 D SITE^FH

 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORR"

 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)

 S MSG(3)="ORC|SR|"_FHORN_"^OR|"_FILL_"||"_FHSTTS

 Q

CONVC ;Convert Amount/Unit in file 118.2, from "C" to "ML".

 F FHII=0:0 S FHII=$O(^FH(118.2,FHII)) Q:FHII'>0  D

 .S FHAU=$P(^FH(118.2,FHII,0),U,3)

 .I FHAU["C" S FHAF=$P(FHAU,"C",1),FHAS=$P(FHAU,"C",2) D

 ..S $P(^FH(118.2,FHII,0),U,3)=FHAF_"ML"_FHAS

 Q

MONUM ;Prompt for number of monitors to display

 W ! K DIR S FHNUM="",DIR("?")="Select ALL to view all monitors, or select a specific number.  For example, enter 20 to display the 20 most recent monitors."

 S DIR(0)="F",DIR("A")="How many monitors would you like to display?"

 S DIR("B")="ALL" D ^DIR

 I $D(DIRUT) S FHNUM="" Q

 S FHNUM=Y I FHNUM'="A",FHNUM'="ALL",FHNUM'?1.5N D MONUM Q

 I FHNUM="A"!(FHNUM="ALL") S FHNUM=99999

 Q

FHOMUTL   ;Hines OIFO/RTK OUTPATIENT MEALS UTILITIES  ;2/04/03  15:15

 +1       ;;5.5;DIETETICS;**1,2,5**;Jan 28, 2005;Build 53

 +2       ;

DIV       ;ask for Communication office if Multi-division.

 +1        NEW FHSCNT,FH

 +2        KILL FHSITE,FHSITENM

 +3        SET FHSCNT=0

           FOR FH=0:0

               SET FH=$ORDER(^FH(119.73,FH))

               IF FH'>0

                   QUIT 

               SET FHSCNT=FHSCNT+1

               SET FHSITE=FH

               SET FHSITENM=$PIECE($GET(^FH(119.73,FH,0)),U,1)

 +4        IF (FHSCNT=1)

               IF ($PIECE($GET(^FH(119.9,1,0)),U,20)'="Y")

                   QUIT 

D2         IF FHSCNT>1

               KILL FHSITE,FHSITENM,X

               READ !!,"Select COMMUNICATION OFFICE (or ALL): ALL// ",X:DTIME

               IF X=""

                   SET X="ALL"

               IF '$TEST!("^"[X)

                   QUIT 

               DO TR^FH

               IF X="ALL"

                   SET FHSITE=0

 +1        IF X'="ALL"

               KILL DIC

               SET DIC="^FH(119.73,"

               SET DIC(0)="EMQ"

               DO ^DIC

               IF Y<1

                   GOTO D2

               SET FHSITE=+Y

               SET FHSITENM=$PIECE(Y,U,2)

 +2        QUIT 

 +3       ;

STDATE    ;Prompt for start date (if FHPSDT="N" do not allow past dates)

 +1        SET STDT=""

           DO NOW^%DTC

           SET Y=X

           DO DD^%DT

           SET FHDTDF=Y

 +2        KILL DIR

           SET DIR("A")="Select Start Date: "

           SET DIR("B")=FHDTDF

 +3        SET DIR(0)="DAO"

           IF $GET(FHPSDT)="N"

               SET DIR(0)="DAO^FHDTDF"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

           SET STDT=Y

           SET Y=STDT

           DO DD^%DT

           WRITE "  ",Y

 +5        QUIT 

ENDATE    ;Prompt for end date

 +1        SET ENDT=""

           DO NOW^%DTC

           SET Y=X

           DO DD^%DT

           SET FHDTDF=Y

           KILL DIR

 +2        SET DIR("A")="Select End Date: "

           SET DIR("B")=FHDTDF

           SET DIR(0)="DAO^"_STDT

           DO ^DIR

 +3        IF $DATA(DIRUT)

               QUIT 

           SET ENDT=Y

           SET Y=ENDT

           DO DD^%DT

           WRITE "  ",Y

 +4        QUIT 

OUTLOC    ;Prompt for outpatient location - screen for ONLY Outpatient Locations

 +1        SET FHLOC=""

           SET FHOUT="O"

 +2        KILL DIC

           SET DIC="^FH(119.6,"

           SET DIC(0)="AEQZ"

 +3        SET DIC("A")="Select Outpatient Ordering Location: "

 +4        SET DIC("S")="I $P(^(0),U,3)=FHOUT"

           DO ^DIC

 +5        IF $DATA(DUOUT)

               QUIT 

           IF Y=-1

               QUIT 

 +6        SET FHLOC=+Y

           SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)

 +7        IF '$ORDER(^FH(119.6,FHLOC,"L",0))

               SET FHLOC=""

               SET FHCOMM=""

               WRITE !!,"The selected location does not have an Associated Hospital Location.  To set",!,"the Associated Hospital Location use option ENTER/EDIT NUTRITION LOCATIONS."

 +8        QUIT 

 +9       ;

RMBED     ;Prompt for outpatient room-bed - must be set up for Outpatient Location

 +1        SET (FHRMBD,FHRMBSL)=""

 +2        IF $GET(FHLOC)=""

               WRITE !!,"No OUTPATIENT LOCATION selected"

               QUIT 

 +3        IF '$DATA(^FH(119.6,FHLOC,"R"))

               QUIT 

 +4        FOR FHRMBI=0:0

               SET FHRMBI=$ORDER(^FH(119.6,FHLOC,"R",FHRMBI))

               IF FHRMBI'>0

                   QUIT 

               Begin DoDot:1

 +5                SET FHRMBPT=$PIECE($GET(^FH(119.6,FHLOC,"R",FHRMBI,0)),U)

                   SET FHRMBSL(FHRMBPT)=1

               End DoDot:1

 +6        KILL DIC

           SET DIC="^DG(405.4,"

           SET DIC(0)="AEQZ"

 +7        SET DIC("A")="Select Outpatient Room-Bed: "

 +8        SET DIC("S")="I $D(FHRMBSL(+Y))"

           DO ^DIC

 +9        IF $DATA(DUOUT)

               QUIT 

           IF Y=-1

               QUIT 

 +10       SET FHRMBD=+Y

 +11       QUIT 

GTFHDFN   ;Get FHDFN, given DFN

 +1        KILL DIR

           SET DIR(0)="NAO"

           SET DIR("B")="ENTER DFN"

           DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

           SET ZZDFN=Y

 +2        SET FHZ115="P"_ZZDFN

           SET FHDFN=$ORDER(^FHPT("B",FHZ115,""))

 +3        IF '$DATA(^DPT(ZZDFN))

               WRITE !!,"DFN '",ZZDFN,"' NOT FOUND IN FILE 2",!

               QUIT 

 +4        IF FHDFN=""

               WRITE !!,"NO CORRESPONDING FHDFN"

 +5        WRITE !!," NAME: ",$PIECE($GET(^DPT(ZZDFN,0)),U,1)

 +6        WRITE !?2,"DFN: ",ZZDFN,!,"FHDFN: ",FHDFN,!

 +7        QUIT 

GETOPT    ;Select outpatient for recurring meals

 +1        SET FHFIND=1

           DO ^FHOMDPA

           IF FHDFN=""

               SET FHFIND=0

               QUIT 

 +2       ;W !!,"UNKNOWN SELECTION !"

           IF '$DATA(^FHPT(FHDFN,0))

               SET FHFIND=0

               QUIT 

 +3        IF $ORDER(^FHPT(FHDFN,"OP",0))=""

               WRITE !!,"NO RECURRING MEALS FOR THIS PERSON"

               SET FHFIND=0

               QUIT 

 +4        WRITE !

           DO STDATE

           IF STDT=""

               SET FHFIND=0

               QUIT 

 +5        QUIT 

PATNAME   ;Get name and demographics of patient/new person

 +1       ;input variable: FHDFN

 +2        SET (FHDOB,FHBID,FHSEX,DFN)=""

           DO GETZN

 +3        IF FILE="P"

               SET FHPTNM=$PIECE($GET(^DPT(IEN,0)),U,1)

 +4        IF FILE="N"

               SET FHPTNM=$PIECE($GET(^VA(200,IEN,0)),U,1)

 +5       ;Get SSN,Age,DOB,Sex of patient/new person

 +6        IF FILE="P"

               Begin DoDot:1

 +7                SET DFN=IEN

 +8                DO PID^FHDPA

                   SET FHSSN=PID

 +9                SET FHSEX=$PIECE($GET(^DPT(DFN,0)),U,2)

                   SET FHDOB=$PIECE($GET(^DPT(DFN,0)),U,3)

 +10               SET FHBID=BID

               End DoDot:1

 +11       IF FILE="N"

               Begin DoDot:1

 +12               SET IEN200=IEN

                   SET FHSSN=$PIECE($GET(^VA(200,IEN,1)),U,9)

 +13               SET FHBID=$EXTRACT(FHSSN,6,$LENGTH(FHSSN))

 +14               SET FHSEX=$PIECE($GET(^VA(200,IEN,1)),U,2)

                   SET FHDOB=$PIECE($GET(^VA(200,IEN,1)),U,3)

               End DoDot:1

 +15       SET FHAGE=""

           DO NOW^%DTC

 +16       IF FHDOB'=""

               SET FHAGE=$EXTRACT(%,1,3)-$EXTRACT(FHDOB,1,3)-($EXTRACT(%,4,7)<$EXTRACT(FHDOB,4,7))

 +17       QUIT 

GETZN     ;Get first piece of zero node in 115

 +1        SET FHPCZN=$PIECE($GET(^FHPT(FHDFN,0)),U,1)

           SET FILE=$EXTRACT(FHPCZN,1)

 +2        SET IEN=$EXTRACT(FHPCZN,2,99)

 +3        QUIT 

DIETVER   ;Verify that diet selected is from the allowable diets in 119.9

 +1        DO DIETLST

           IF $DATA(FHDIETS(FHDIET))

               QUIT 

 +2        SET FHDIET=""

           WRITE *7," ==> NOT ALLOWED",!

           DO DIETMSG

           QUIT 

DIETHLP   ;Display allowable diets from 119.9

 +1        DO DIETLST

           DO DIETMSG

           QUIT 

DIETLST   ;Build list

 +1        KILL FHDIETS,SPD

           SET FHSPDTS=""

           SET SPD=$PIECE($GET(^FH(119.9,1,0)),U,2,6)_"^"_$PIECE($GET(^FH(119.9,1,1)),U,1,10)

 +2        SET FHDEF=$PIECE($GET(^FH(119.9,1,0)),U,2)

 +3        FOR A=1:1:15

               SET AB=$PIECE(SPD,U,A)

               Begin DoDot:1

 +4                IF AB=""

                       QUIT 

 +5                SET FHDIETS(AB)=AB

 +6                SET FHSPDTS=FHSPDTS_$PIECE($GET(^FH(111,AB,0)),U,1)_"^"

               End DoDot:1

 +7        QUIT 

DIETMSG   ;Display message

 +1        WRITE !?3,"You must select from the diets set up in the Site Parameters:"

 +2        SET AB=""

           FOR 

               SET AB=$ORDER(FHDIETS(AB))

               IF AB'>0

                   QUIT 

               WRITE !?3,$PIECE($GET(^FH(111,AB,0)),U)

 +3        WRITE !

           QUIT 

 +4        QUIT 

EXMSG     ;Display message stating meal NOT ordered

 +1        DO TYPE

 +2        WRITE !!?3,FHMSGML," NOT ordered!",!

           HANG 2

 +3        QUIT 

OKMSG     ;Display message stating meal ordered successfully

 +1        DO TYPE

 +2        DO PATNAME

           WRITE !!?3,FHMSGML," ordered for ",FHPTNM,"...",!

           HANG 2

 +3        QUIT 

TYPE      ;

 +1        SET FHMSGML=$SELECT(FHMSG1="G":"Guest meal",FHMSG1="S":"Special meal",FHMSG1="R":"Recurring meal",FHMSG1="E":"Early/Late tray",FHMSG1="T":"Tubefeeding",1:"Additional order")

 +2        QUIT 

UPXMSG    ;

 +1        WRITE !!?3,"Recurring meal NOT updated! ",!

           HANG 2

 +2        QUIT 

UPDMSG    ;

 +1        DO PATNAME

           WRITE !!?3,"Recurring meal updated for ",FHPTNM,"...",!

           HANG 2

 +2        QUIT 

SMSTAT    ;Status of last special meal request

 +1        SET FHSMNUM=$ORDER(^FHPT(FHDFN,"SM","B",""),-1)

           IF FHSMNUM=""

               SET FHSTAT=""

               QUIT 

 +2        IF $EXTRACT(FHSMNUM,1,7)'=DT

               SET FHSTAT=""

               QUIT 

 +3        SET FHSTAT=$PIECE($GET(^FHPT(FHDFN,"SM",FHSMNUM,0)),U,2)

 +4        QUIT 

RANGE     ;Check for validity of range of numbers entered

 +1        SET FHCLST=""

           SET FLG=""

           SET X=FHNUM

           DO TR^FH

           SET FHNUM=X

 +2        IF FHNUM="A"!(FHNUM?1"A"1.2"L")

               SET FHNUM="1-"_NUM

 +3        FOR K=1:1

               SET K1=$PIECE(FHNUM,",",K)

               IF K1=""!(FLG="QUIT")

                   QUIT 

               Begin DoDot:1

 +4                SET K2=$SELECT(K1["-":$PIECE(K1,"-",2),1:+K1)

                   SET K1=+K1

                   DO CK

                   IF FLG="QUIT"

                       QUIT 

 +5                FOR K3=K1:1:K2

                       SET FHCLST=FHCLST_K3_","

               End DoDot:1

 +6        QUIT 

CK         IF K1<1!(K1>NUM)!(K1'?1N.N)

               DO C1

               QUIT 

 +1        IF K2<1!(K2>NUM)!(K2'?1N.N)

               DO C1

               QUIT 

 +2        IF K2'<K1

               QUIT 

C1         WRITE !,"  Enter numbers or range or ALL (E.G.,  1,3,4 or 3-5 or 1,3-5)"

           SET FLG="QUIT"

           SET FHCLST=""

           QUIT 

 +1        QUIT 

MSHOM     ;Code MSG for outpatient orders

 +1        DO SITE^FH

 +2        SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"

 +3        SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)

 +4       ;RESULTS IN NO BKDOOR

           SET FHOLOC=$ORDER(^FH(119.6,FHLOC,"L",0))

           IF FHOLOC=""

               QUIT 

 +5        SET FHOLOC=$GET(^FH(119.6,FHLOC,"L",FHOLOC,0))

 +6        SET FHOLOCNM=$PIECE($GET(^SC(FHOLOC,0)),U,1)

 +7        SET MSG(3)="PV1||O|"_FHOLOC_"^"_FHOLOCNM_"||||||||||||||||"

 +8        QUIT 

MSHCA     ;Code Cancel/Discontinue for outpatient orders

 +1        DO NOW^%DTC

           SET FHNOW=%

           KILL MSG

           SET ACT="OC"

           DO SITE^FH

 +2        IF $GET(FHCATXT)=""

               SET FHCATXT="Dietetics Canceled order."

 +3        SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"

 +4        SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)

 +5        SET DATE=$$FMTHL7^XLFDT(FHNOW)

 +6        SET MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_DUZ_"|||"_DATE_"|"_FHCATXT

 +7        QUIT 

MSHSS     ;Code MSG for outpatient send status messages

 +1        DO SITE^FH

 +2        SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORR"

 +3        SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)

 +4        SET MSG(3)="ORC|SR|"_FHORN_"^OR|"_FILL_"||"_FHSTTS

 +5        QUIT 

CONVC     ;Convert Amount/Unit in file 118.2, from "C" to "ML".

 +1        FOR FHII=0:0

               SET FHII=$ORDER(^FH(118.2,FHII))

               IF FHII'>0

                   QUIT 

               Begin DoDot:1

 +2                SET FHAU=$PIECE(^FH(118.2,FHII,0),U,3)

 +3                IF FHAU["C"

                       SET FHAF=$PIECE(FHAU,"C",1)

                       SET FHAS=$PIECE(FHAU,"C",2)

                       Begin DoDot:2

 +4                        SET $PIECE(^FH(118.2,FHII,0),U,3)=FHAF_"ML"_FHAS

                       End DoDot:2

               End DoDot:1

 +5        QUIT 

MONUM     ;Prompt for number of monitors to display

 +1        WRITE !

           KILL DIR

           SET FHNUM=""

           SET DIR("?")="Select ALL to view all monitors, or select a specific number.  For example, enter 20 to display the 20 most recent monitors."

 +2        SET DIR(0)="F"

           SET DIR("A")="How many monitors would you like to display?"

 +3        SET DIR("B")="ALL"

           DO ^DIR

 +4        IF $DATA(DIRUT)

               SET FHNUM=""

               QUIT 

 +5        SET FHNUM=Y

           IF FHNUM'="A"

               IF FHNUM'="ALL"

                   IF FHNUM'?1.5N

                       DO MONUM

                       QUIT 

 +6        IF FHNUM="A"!(FHNUM="ALL")

               SET FHNUM=99999

 +7        QUIT