FHNO8 ; HISC/REL - History of Supp. Fdgs. ;5/17/93 14:24
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
;patch #5 - add outpatient SFs,
;
SF K FHDFN,X,WARD,SDT,EDT,STDT,ENDT
S ADM="",FHALL=1 D ^FHOMDPA
G:'FHDFN KIL
I $O(^FHPT(FHDFN,"A",0))<1 W !!,"NO ADMISSIONS ON FILE!" G OSF
S DIC="^FHPT(FHDFN,""A"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
S WARD="" I $G(DFN)'="" S WARD=$G(^DPT(DFN,.1))
K ADM
SF0 W !!,"Select ADMISSION or RETURN for OUTPATIENT ",$S(WARD'="":" (or C for CURRENT)",1:""),": " R X:DTIME G:X["^" KIL D:X="c" TR^FH
I (X="")&'($D(^FHPT(FHDFN,"OP"))) W !!,"NO OUTPATIENT DATA ON FILE!" G SF
I (X="")&($D(^FHPT(FHDFN,"OP"))) G OSF
I WARD'="",X="C" S ADM=$G(^DPT("CN",WARD,DFN)) G CAD:ADM
S DIC="^FHPT(FHDFN,""A"",",DIC(0)="EQM" D ^DIC G:Y<1 SF0 S ADM=+Y
CAD I $G(ADM),$G(^FHPT(FHDFN,"A",ADM,0)) G IN
;
SF1 I '($D(^FHPT(FHDFN,"OP"))) W !!,"NO OUTPATIENT DATA ON FILE!" G SF
W !!,"Enter the Start Date and End Date for outpatient data.",!
D STDATE^FHOMUTL S SDT=STDT I STDT="" Q
S X="T+30" D ^%DT S ENDT=Y
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
D ADM
Q
OSF ;process outpatient SFs.
;
S FHSFLG=0
S FHSOOP=$O(^FHPT(FHDFN,"OP","B",DT-30))
I '$D(^FHPT(FHDFN,"OP"))!'$G(FHSOOP) G FHNO8
;W !!,"Outpatient Recurring Meals... "
D ASK0
G:'$G(ADM) SF
S (N1,LST)=0
I $G(ADM) F K=0:0 S K=$O(^FHPT(FHDFN,"OP",ADM,"SF",K)) Q:K<1 S X=^(K,0),LST=K D LIS
I $G(ADM),'N1 W !!,"No Supplemental Feedings for this outpatient date!",! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Exit" D ^DIR Q:'Y G OSF
I $G(ADM),$G(N1) G OSF0
G OSF
OSF0 R !!,"Detailed Display of which Order #? ",X:DTIME G:'$T!("^"[X) FHNO8 I X'?1N.N!(X<1)!(X>LST) W *7," Enter # of Order to List" G OSF0
S NO=+X,Y=$G(^FHPT(FHDFN,"OP",ADM,"SF",NO,0)) D:Y'="" L1^FHNO7
G SF
Q
ASK0 ;ask for Recurring Meal entry.
K ADM
W @IOF,!,"Outpatient Recurring Meals... "
S FHQ=0,FHSDT=DT-60
F FHI=FHSDT-1:0 S FHI=$O(^FHPT("RM",FHI)) Q:FHI'>0!FHQ F FHJ=0:0 S FHJ=$O(^FHPT("RM",FHI,FHDFN,FHJ)) Q:FHJ'>0!FHQ I ($P($G(^FHPT(FHDFN,"OP",FHJ,0)),U,15)'="C") D
.S FHDA15=$G(^FHPT(FHDFN,"OP",FHJ,0))
.S FHMEAL=$P(FHDA15,U,4),FHLOC=$P(FHDA15,U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL="B":"Break",FHMEAL="N":"Noon",1:"Even"),FH11=FHMEAL_" "_FHLOCN
.S Y=$P(FHDA15,U,1) X ^DD("DD") S DTP=Y
.S (FHCOFLG,FHDATL,FHSF)=0
.I $Y>(IOSL-5) K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Quit Listing" D ^DIR W:Y @IOF I 'Y S FHQ=1 Q
.W !,DTP,?12,FH11
.S FHDATL=$L(DTP)+13+$L(FH11)
.S:$D(^FHPT(FHDFN,"OP",FHJ,"SF",0)) FHSF=$P(^FHPT(FHDFN,"OP",FHJ,"SF",0),U,3)
.Q:'$G(FHSF)
.S FHDA15SF=$G(^FHPT(FHDFN,"OP",FHJ,"SF",FHSF,0))
.Q:$P(FHDA15SF,U,32)
.S FHDASFNM=$P($G(^FH(118.1,$P(FHDA15SF,U,4),0)),U,1)
.W ?40," (",FHDASFNM,")"
W !
K DIC S DIC(0)="AEQM"
S DIC("W")="S FHMEAL=$P(^(0),U,4),FHLOC=$P(^(0),U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL=""B"":""Break"",FHMEAL=""N"":""Noon"",1:""Even""),FH11=FHMEAL_"" ""_FHLOCN D EN^DDIOL(FH11,"""",""?3"")"
S DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-60)"
S DIC="^FHPT(FHDFN,""OP"","
S DIC("?")="Select a Date, '^' to exit"
S DIC("A")="Select the Outpatient Date :" D ^DIC K DIC Q:(Y'>0)!$D(DTOUT)
S ADM=+Y
S FHMEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) ;outpatient standing orders.
Q
;
S ALL=1 D ^FHDPA G:'DFN KIL G:'FHDFN KIL
I $O(^FHPT(FHDFN,"A",0))<1 W !!,"NO ADMISSIONS ON FILE!" G FHNO8
S DIC="^FHPT(FHDFN,""A"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
A0 W !!,"Select ADMISSION",$S($D(^DPT(DFN,.1)):" (or C for CURRENT)",1:""),": " R X:DTIME G:'$T!("^"[X) KIL D:X="c" TR^FH
;
IN ;D ADM G SF0:ADM'>0
;
P0 S (N1,LST)=0 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SF",K)) Q:K<1 S X=^(K,0),LST=K D LIS
I 'N1 W !!,"No Supplemental Feedings for this Admission!" G FHNO8
P1 R !!,"Detailed Display of which Order #? ",X:DTIME G:'$T!("^"[X) FHNO8 I X'?1N.N!(X<1)!(X>LST) W *7," Enter # of Order to List" G P1
S NO=+X,Y=$G(^FHPT(FHDFN,"A",ADM,"SF",NO,0)) D L1^FHNO7
G SF
ADM ;S WARD=$G(^DPT(DFN,.1))
;I WARD="" W *7,!!,"NOT CURRENTLY AN INPATIENT!",! S ADM="" Q
;S ADM=$G(^DPT("CN",WARD,DFN)) Q
;
LIS I 'N1 W !!,"Ord Date/Time Ordered Supplemental Feeding Menu Date/Time Cancelled",!
S N1=N1+1,D1=$P(X,"^",2),NM=$P(X,"^",4),D2=$P(X,"^",32)
S DTP=D1 D DTP^FH W !,$J(K,3)," ",DTP
S X=$P($G(^FH(118.1,+NM,0)),"^",1) W:X'="" ?24,X
I D2 S DTP=D2 D DTP^FH W ?54,DTP
Q
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNO8 4604 printed Sep 23, 2025@19:28:24 Page 2
FHNO8 ; HISC/REL - History of Supp. Fdgs. ;5/17/93 14:24
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
+2 ;patch #5 - add outpatient SFs,
+3 ;
SF KILL FHDFN,X,WARD,SDT,EDT,STDT,ENDT
+1 SET ADM=""
SET FHALL=1
DO ^FHOMDPA
+2 if 'FHDFN
GOTO KIL
+3 IF $ORDER(^FHPT(FHDFN,"A",0))<1
WRITE !!,"NO ADMISSIONS ON FILE!"
GOTO OSF
+4 SET DIC="^FHPT(FHDFN,""A"","
SET DIC(0)="Q"
SET DA=FHDFN
SET X="??"
DO ^DIC
+5 SET WARD=""
IF $GET(DFN)'=""
SET WARD=$GET(^DPT(DFN,.1))
+6 KILL ADM
SF0 WRITE !!,"Select ADMISSION or RETURN for OUTPATIENT ",$SELECT(WARD'="":" (or C for CURRENT)",1:""),": "
READ X:DTIME
if X["^"
GOTO KIL
if X="c"
DO TR^FH
+1 IF (X="")&'($DATA(^FHPT(FHDFN,"OP")))
WRITE !!,"NO OUTPATIENT DATA ON FILE!"
GOTO SF
+2 IF (X="")&($DATA(^FHPT(FHDFN,"OP")))
GOTO OSF
+3 IF WARD'=""
IF X="C"
SET ADM=$GET(^DPT("CN",WARD,DFN))
if ADM
GOTO CAD
+4 SET DIC="^FHPT(FHDFN,""A"","
SET DIC(0)="EQM"
DO ^DIC
if Y<1
GOTO SF0
SET ADM=+Y
CAD IF $GET(ADM)
IF $GET(^FHPT(FHDFN,"A",ADM,0))
GOTO IN
+1 ;
SF1 IF '($DATA(^FHPT(FHDFN,"OP")))
WRITE !!,"NO OUTPATIENT DATA ON FILE!"
GOTO SF
+1 WRITE !!,"Enter the Start Date and End Date for outpatient data.",!
+2 DO STDATE^FHOMUTL
SET SDT=STDT
IF STDT=""
QUIT
+3 SET X="T+30"
DO ^%DT
SET ENDT=Y
+4 DO DD^%DT
SET FHDTDF=Y
KILL DIR
+5 SET DIR("A")="Select End Date: "
SET DIR("B")=FHDTDF
SET DIR(0)="DAO^"_STDT
+6 DO ^DIR
+7 if $DATA(DIRUT)
QUIT
SET ENDT=Y
SET Y=ENDT
DO DD^%DT
WRITE " ",Y
+8 DO ADM
+9 QUIT
OSF ;process outpatient SFs.
+1 ;
+2 SET FHSFLG=0
+3 SET FHSOOP=$ORDER(^FHPT(FHDFN,"OP","B",DT-30))
+4 IF '$DATA(^FHPT(FHDFN,"OP"))!'$GET(FHSOOP)
GOTO FHNO8
+5 ;W !!,"Outpatient Recurring Meals... "
+6 DO ASK0
+7 if '$GET(ADM)
GOTO SF
+8 SET (N1,LST)=0
+9 IF $GET(ADM)
FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"OP",ADM,"SF",K))
if K<1
QUIT
SET X=^(K,0)
SET LST=K
DO LIS
+10 IF $GET(ADM)
IF 'N1
WRITE !!,"No Supplemental Feedings for this outpatient date!",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue or '^' to Exit"
DO ^DIR
if 'Y
QUIT
GOTO OSF
+11 IF $GET(ADM)
IF $GET(N1)
GOTO OSF0
+12 GOTO OSF
OSF0 READ !!,"Detailed Display of which Order #? ",X:DTIME
if '$TEST!("^"[X)
GOTO FHNO8
IF X'?1N.N!(X<1)!(X>LST)
WRITE *7," Enter # of Order to List"
GOTO OSF0
+1 SET NO=+X
SET Y=$GET(^FHPT(FHDFN,"OP",ADM,"SF",NO,0))
if Y'=""
DO L1^FHNO7
+2 GOTO SF
+3 QUIT
ASK0 ;ask for Recurring Meal entry.
+1 KILL ADM
+2 WRITE @IOF,!,"Outpatient Recurring Meals... "
+3 SET FHQ=0
SET FHSDT=DT-60
+4 FOR FHI=FHSDT-1:0
SET FHI=$ORDER(^FHPT("RM",FHI))
if FHI'>0!FHQ
QUIT
FOR FHJ=0:0
SET FHJ=$ORDER(^FHPT("RM",FHI,FHDFN,FHJ))
if FHJ'>0!FHQ
QUIT
IF ($PIECE($GET(^FHPT(FHDFN,"OP",FHJ,0)),U,15)'="C")
Begin DoDot:1
+5 SET FHDA15=$GET(^FHPT(FHDFN,"OP",FHJ,0))
+6 SET FHMEAL=$PIECE(FHDA15,U,4)
SET FHLOC=$PIECE(FHDA15,U,3)
SET FHLOCN=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
SET FHMEAL=$SELECT(FHMEAL="B":"Break",FHMEAL="N":"Noon",1:"Even")
SET FH11=FHMEAL_" "_FHLOCN
+7 SET Y=$PIECE(FHDA15,U,1)
XECUTE ^DD("DD")
SET DTP=Y
+8 SET (FHCOFLG,FHDATL,FHSF)=0
+9 IF $Y>(IOSL-5)
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue or '^' to Quit Listing"
DO ^DIR
if Y
WRITE @IOF
IF 'Y
SET FHQ=1
QUIT
+10 WRITE !,DTP,?12,FH11
+11 SET FHDATL=$LENGTH(DTP)+13+$LENGTH(FH11)
+12 if $DATA(^FHPT(FHDFN,"OP",FHJ,"SF",0))
SET FHSF=$PIECE(^FHPT(FHDFN,"OP",FHJ,"SF",0),U,3)
+13 if '$GET(FHSF)
QUIT
+14 SET FHDA15SF=$GET(^FHPT(FHDFN,"OP",FHJ,"SF",FHSF,0))
+15 if $PIECE(FHDA15SF,U,32)
QUIT
+16 SET FHDASFNM=$PIECE($GET(^FH(118.1,$PIECE(FHDA15SF,U,4),0)),U,1)
+17 WRITE ?40," (",FHDASFNM,")"
End DoDot:1
+18 WRITE !
+19 KILL DIC
SET DIC(0)="AEQM"
+20 SET DIC("W")="S FHMEAL=$P(^(0),U,4),FHLOC=$P(^(0),U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL=""B"":""Break"",FHMEAL=""N"":""Noon"",1:""Even""),FH11=FHMEAL_"" ""_FHLOCN D EN^DDIOL(FH11,"""",""?3"")"
+21 SET DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-60)"
+22 SET DIC="^FHPT(FHDFN,""OP"","
+23 SET DIC("?")="Select a Date, '^' to exit"
+24 SET DIC("A")="Select the Outpatient Date :"
DO ^DIC
KILL DIC
if (Y'>0)!$DATA(DTOUT)
QUIT
+25 SET ADM=+Y
+26 ;outpatient standing orders.
SET FHMEAL=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,4)
+27 QUIT
+28 ;
+29 SET ALL=1
DO ^FHDPA
if 'DFN
GOTO KIL
if 'FHDFN
GOTO KIL
+30 IF $ORDER(^FHPT(FHDFN,"A",0))<1
WRITE !!,"NO ADMISSIONS ON FILE!"
GOTO FHNO8
+31 SET DIC="^FHPT(FHDFN,""A"","
SET DIC(0)="Q"
SET DA=FHDFN
SET X="??"
DO ^DIC
A0 WRITE !!,"Select ADMISSION",$SELECT($DATA(^DPT(DFN,.1)):" (or C for CURRENT)",1:""),": "
READ X:DTIME
if '$TEST!("^"[X)
GOTO KIL
if X="c"
DO TR^FH
+1 ;
IN ;D ADM G SF0:ADM'>0
+1 ;
P0 SET (N1,LST)=0
FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"SF",K))
if K<1
QUIT
SET X=^(K,0)
SET LST=K
DO LIS
+1 IF 'N1
WRITE !!,"No Supplemental Feedings for this Admission!"
GOTO FHNO8
P1 READ !!,"Detailed Display of which Order #? ",X:DTIME
if '$TEST!("^"[X)
GOTO FHNO8
IF X'?1N.N!(X<1)!(X>LST)
WRITE *7," Enter # of Order to List"
GOTO P1
+1 SET NO=+X
SET Y=$GET(^FHPT(FHDFN,"A",ADM,"SF",NO,0))
DO L1^FHNO7
+2 GOTO SF
ADM ;S WARD=$G(^DPT(DFN,.1))
+1 ;I WARD="" W *7,!!,"NOT CURRENTLY AN INPATIENT!",! S ADM="" Q
+2 ;S ADM=$G(^DPT("CN",WARD,DFN)) Q
+3 ;
LIS IF 'N1
WRITE !!,"Ord Date/Time Ordered Supplemental Feeding Menu Date/Time Cancelled",!
+1 SET N1=N1+1
SET D1=$PIECE(X,"^",2)
SET NM=$PIECE(X,"^",4)
SET D2=$PIECE(X,"^",32)
+2 SET DTP=D1
DO DTP^FH
WRITE !,$JUSTIFY(K,3)," ",DTP
+3 SET X=$PIECE($GET(^FH(118.1,+NM,0)),"^",1)
if X'=""
WRITE ?24,X
+4 IF D2
SET DTP=D2
DO DTP^FH
WRITE ?54,DTP
+5 QUIT
KIL GOTO KILL^XUSCLEAN
