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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMUTL 7283 printed Sep 23, 2025@19:29:12 Page 2
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
