FHNO7 ; HISC/REL - List Supplemental Fdgs. ;12/15/94 09:14
;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28
;patch #5 - add outpatient SF. ;patch #8 - add allergy display
LIS ; Display Feeding
S (FHLOCN,Y)=""
I WARD'="" S NAM=$P($G(^DPT(DFN,0)),"^",1) D CUR^FHORD7
I WARD="",'$G(ADM) Q
I WARD="" D PATNAME^FHOMUTL S NAM=FHPTNM,FHDIET=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,2) D
.S:FHDIET Y=$P($G(^FH(111,FHDIET,0)),U,7) I 'FHDIET S FHRNUM=ADM D DIETPAT^FHOMRR1 S Y=FHDIETP
.S FHLOC=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,3) S:$G(FHLOC) FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
W:$E(IOST,1,2)="C-" @IOF W !!,NAM," " W:WARD'="" "( ",WARD," )" W:FHLOCN'="" "( ",FHLOCN," )"
I WARD="",$D(^FHPT(FHDFN,"OP",ADM,0)) S DTP=$P(^FHPT(FHDFN,"OP",ADM,0),U,1) D DTP^FH W ?50,"Outpatient Date: ",DTP
W !!,"Current Diet: ",$S(Y'="":Y,1:"No current order")
D ALG^FHCLN W !," Allergies: ",$S(ALG="":"None on file",1:ALG)
I WARD'="" S NO=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",7),Y=$S('NO:"",1:$G(^FHPT(FHDFN,"A",ADM,"SF",NO,0)))
I WARD="" S NO=$P($G(^FHPT(FHDFN,"OP",ADM,"SF",0)),"^",3),Y=$S('NO:"",1:$G(^FHPT(FHDFN,"OP",ADM,"SF",NO,0))) I $P(Y,"^",32)'="" S (NO,Y)=""
I WARD="" W:$D(FHMEAL) ?50,"MEAL: ",$S(FHMEAL="B":"Breakfast",FHMEAL="N":"Noon",1:"Evening")
L1 ; Display SF Order
I '$D(WARD) S WARD=""
S NM=$P(Y,"^",4) W !,"Feeding Menu: ",$S('NM:"None",1:$P(^FH(118.1,NM,0),"^",1)) Q:'NO S DTP=$P(Y,"^",30) D DTP^FH W ?50,"Reviewed: ",DTP
I WARD'="" W !!,"10AM",?26,"2PM",?52,"8PM",!,"----------------------- ----------------------- -----------------------"
I WARD="",$D(FHMEAL),FHMEAL="B" W !!,"10AM",!,"----------------------------------------------------------------------------"
I WARD="",$D(FHMEAL),FHMEAL="N" W !!,"2PM",!,"-----------------------------------------------------------------------------"
I WARD="",$D(FHMEAL),FHMEAL="E" W !!,"8PM",!,"-----------------------------------------------------------------------------"
K N F K1=1:1:3 F K2=1:1:4 S N(K1,K2)=""
S L=4 F K1=1:1:3 S K=0 F K2=1:1:4 S Z=$P(Y,"^",L+1),Q=$P(Y,"^",L+2),L=L+2 I Z'="" S:'Q Q=1 S K=K+1,N(K1,K)=$J(Q,2)_" "_$P($G(^FH(118,Z,0)),"^",1)
I WARD'="" F K2=1:1:4 W !,N(1,K2),?26,N(2,K2),?52,N(3,K2)
I WARD="",$D(FHMEAL) F K2=1:1:4 W !,$S(FHMEAL="B":N(1,K2),FHMEAL="N":N(2,K2),1:N(3,K2))
W:$P(Y,"^",34)'="" !!,"Diet Pattern Associated: ",$S($P(Y,"^",34)="Y":"YES",1:"NO")
Q
EN2 ; Supplemental Feeding Inquiry
K FHSFLG,FHDFN,FHPTNM,FHMEAL,ADM,NO,Y,X
S FHALL=1 D ^FHOMDPA G:'FHDFN KIL
S WARD="" I $G(DFN)'="" S WARD=$G(^DPT(DFN,.1)) I WARD'="" D LIS G EN2
I WARD="" D SF
I '$G(FHSFLG) W !,"NO OUTPATIENT DATA ON FILE for today's date and the future!!" G EN2
D SF0
D:$G(ADM) LIS G EN2
;
SF ;LIST outpatient SF
W @IOF,!,"Outpatient Recurring Meals... "
S FHQ=0
F FHI=DT-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
.S FHSFLG=1
.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 !
Q
;
;K DIC
;S DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-1),($P(^(0),U,15)'=""C"")"
;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="^FHPT(FHDFN,""OP"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
SF0 ;ask for outpatient SF.
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-1),($P(^(0),U,15)'=""C"")"
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)
Q
;
OIS ;Outpatient Individualized SF
Q:'NM
I '$D(FHX) S FHX="ALL"
I (FHX="ALL")!($L(FHX)=3) S FHIDI="BNE"
I $L(FHX)=2 S FHIDI=$S(FHX="NB":"BN",FHX="EB":"BE",FHX="EN":"NE",1:FHX)
I $L(FHX)=1 S FHIDI=FHX
F FHII=1,2,3 S FHMEAL=$E(FHIDI,FHII) Q:FHII'>0!(FHMEAL="") D G0
D G6
Q
G0 ;process each meals for individualized SF.
S T1=$S(FHMEAL="B":"10am",FHMEAL="N":"2pm",1:"8pm")
S KK=$S(FHMEAL="B":1,FHMEAL="N":5,1:9)
;I NM'=1 D CAN^FHNO5,ADD^FHNO5
S DIC="^FH(118,",DIC(0)="EQM",DIC("S")="I $P(^(0),U,3)'=""Y"""
;
G1 G:KK>12 G5
I ((WARD="")&(FHMEAL="B")&(KK>4))!((WARD="")&(FHMEAL="N")&(KK>8)) G G5
;I WARD'="" S T1=$P("10am^2pm^8pm","^",KK-1\4+1)
S T2="#"_(KK-1#4+1),P1=KK*2+3
S DIC("A")=T1_" Feeding "_T2_": "
S OLD=$P(PNN,"^",P1) I OLD S DIC("A")=DIC("A")_$P(^FH(118,+OLD,0),"^",1)_"// "
;
G2 W !!,DIC("A") R X:DTIME G:'$T!(X["^") G5
I X="" G:OLD G3 S KK=$S(KK<5:5,KK<9:9,1:13) G G1
I OLD,X="@" S $P(PNN,"^",P1)="",$P(PNN,"^",P1+1)="" S KK=KK+1 G G1
D ^DIC G:Y<1 G2 S Y=+Y,K1=$S(KK<5:1,KK<9:5,1:9)
F L=K1:1:K1+3 I L'=KK,$P(PNN,"^",L*2+3)=Y W *7," .. DUPLICATE OF EXISTING ITEM!" G G2
S:OLD'=Y $P(PNN,"^",P1)=Y
;
G3 S OLD=$P(PNN,"^",P1+1)
;
G4 W !,T1," ",T2," Qty: ",$S(OLD="":1,1:OLD),"// " R X:DTIME G:'$T!(X["^") G5
S:X="@" X=0 I X="" S:OLD="" $P(PNN,"^",P1+1)=1 S KK=KK+1 G G1
I X'?1N.N!(X>20) W *7," ??" S X="?"
I X["?" W !?5,"Enter a whole number between 1 and 20" G G4
I 'X S $P(PNN,"^",P1)="",$P(PNN,"^",P1+1)="" S KK=KK+1 G G1
S $P(PNN,"^",P1+1)=X,KK=KK+1 G G1
;
G5 S KK=3,X="" F T1=0:1:2 S P1=T1*8-1 F T2=1:1:4 S KK=KK+2 I $P(PNN,"^",KK) S P1=P1+2,$P(X,"^",P1,P1+1)=$P(PNN,"^",KK,KK+1)
;I X="" D CAN^FHNO5 Q
Q
;
G6 S P1=$P(PNN,"^",29) S:P1="" P1="D" W !!,"Dietary or Therapeutic? ",P1,"// " R Y:DTIME S:'$T!("^"[Y) Y=P1
S:$P("dietary",Y,1)="" Y="D" S:$P("therapeutic",Y,1)="" Y="T"
I $P("DIETARY",Y,1)'="",$P("THERAPEUTIC",Y,1)'="" W *7,!?5," Answer D for Dietary use or T for Therapeutic use" G G6
S $P(X,"^",25)=$E(Y,1),PNN=$P(PNN,"^",1,4)_"^"_X
;G:$P(PNO,"^",5,29)=X UPD^FHNO5 D CAN^FHNO5
S FHPNNSV=PNN
S FHIDFLG=1
Q
;
CPRSF ;check previous SF
K PNN
S (FHDAT,FHSF)=""
CPRS1 I FHSF="" S FHSF=$O(^FHPT(FHDFN,"OP",999999999),-1)
E S FHSF=$O(^FHPT(FHDFN,"OP",FHSF),-1)
Q:'$G(FHSF)
S FHDAT=$G(^FHPT(FHDFN,"OP",FHSF,0)),FHPRML=$P(FHDAT,U,4),FHPRCN=$P(FHDAT,U,15),FHLOCN=$P(FHDAT,U,3)
I (FHPRML'=FHMEAL)!(FHPRCN="C")!'$D(^FHPT(FHDFN,"OP",FHSF,"SF",0)) G CPRS1
S FHI=$P($G(^FHPT(FHDFN,"OP",FHSF,"SF",0)),U,3) Q:FHI'>0
S PNN=$G(^FHPT(FHDFN,"OP",FHSF,"SF",FHI,0)),FHSFCX=$P(PNN,U,32)
I $G(FHSFCX) K PNN G CPRS1
I $P(PNN,U,34)="Y" K PNN Q
S $P(PNN,U,3)=DUZ,FHNMSAV=$P(PNN,U,4)
Q
PPRSF ;PROCESS previous SF
Q:'$D(PNN)
D NOW^%DTC S NOW=%
D ADDOUT^FHNO5
Q
SFEVNT ;
S FHDTC=0
S FHLOCN="" I $D(FHLOC),$G(FHLOC),$D(^FH(119.6,FHLOC,0)) S FHLOCN=$P(^(0),U,1)
S FHDTC=FHDTC+1,DTP=FHOSTDT D DTP^FH S:FHDTC=1 FHDTP=DTP
S DTP=$P(ENDT,".",1) D DTP^FH
I DTP'=FHDTP S FHDTP=FHDTP_" to "_DTP
I FHADSFF=1 S FHACT="O",FHTXT="Outpatient Supplemental Feeding: "_FHSFMEN_" ("_FHMEAL_") , "_FHLOCN_", "_FHDTP D OPFILE^FHORX
Q
;
KIL G KILL^XUSCLEAN
FHNO7 ; HISC/REL - List Supplemental Fdgs. ;12/15/94 09:14
+1 ;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28
+2 ;patch #5 - add outpatient SF. ;patch #8 - add allergy display
LIS ; Display Feeding
+1 SET (FHLOCN,Y)=""
+2 IF WARD'=""
SET NAM=$PIECE($GET(^DPT(DFN,0)),"^",1)
DO CUR^FHORD7
+3 IF WARD=""
IF '$GET(ADM)
QUIT
+4 IF WARD=""
DO PATNAME^FHOMUTL
SET NAM=FHPTNM
SET FHDIET=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,2)
Begin DoDot:1
+5 IF FHDIET
SET Y=$PIECE($GET(^FH(111,FHDIET,0)),U,7)
IF 'FHDIET
SET FHRNUM=ADM
DO DIETPAT^FHOMRR1
SET Y=FHDIETP
+6 SET FHLOC=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,3)
IF $GET(FHLOC)
SET FHLOCN=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
End DoDot:1
+7 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !!,NAM," "
IF WARD'=""
WRITE "( ",WARD," )"
IF FHLOCN'=""
WRITE "( ",FHLOCN," )"
+8 IF WARD=""
IF $DATA(^FHPT(FHDFN,"OP",ADM,0))
SET DTP=$PIECE(^FHPT(FHDFN,"OP",ADM,0),U,1)
DO DTP^FH
WRITE ?50,"Outpatient Date: ",DTP
+9 WRITE !!,"Current Diet: ",$SELECT(Y'="":Y,1:"No current order")
+10 DO ALG^FHCLN
WRITE !," Allergies: ",$SELECT(ALG="":"None on file",1:ALG)
+11 IF WARD'=""
SET NO=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",7)
SET Y=$SELECT('NO:"",1:$GET(^FHPT(FHDFN,"A",ADM,"SF",NO,0)))
+12 IF WARD=""
SET NO=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,"SF",0)),"^",3)
SET Y=$SELECT('NO:"",1:$GET(^FHPT(FHDFN,"OP",ADM,"SF",NO,0)))
IF $PIECE(Y,"^",32)'=""
SET (NO,Y)=""
+13 IF WARD=""
IF $DATA(FHMEAL)
WRITE ?50,"MEAL: ",$SELECT(FHMEAL="B":"Breakfast",FHMEAL="N":"Noon",1:"Evening")
L1 ; Display SF Order
+1 IF '$DATA(WARD)
SET WARD=""
+2 SET NM=$PIECE(Y,"^",4)
WRITE !,"Feeding Menu: ",$SELECT('NM:"None",1:$PIECE(^FH(118.1,NM,0),"^",1))
IF 'NO
QUIT
SET DTP=$PIECE(Y,"^",30)
DO DTP^FH
WRITE ?50,"Reviewed: ",DTP
+3 IF WARD'=""
WRITE !!,"10AM",?26,"2PM",?52,"8PM",!,"----------------------- ----------------------- -----------------------"
+4 IF WARD=""
IF $DATA(FHMEAL)
IF FHMEAL="B"
WRITE !!,"10AM",!,"----------------------------------------------------------------------------"
+5 IF WARD=""
IF $DATA(FHMEAL)
IF FHMEAL="N"
WRITE !!,"2PM",!,"-----------------------------------------------------------------------------"
+6 IF WARD=""
IF $DATA(FHMEAL)
IF FHMEAL="E"
WRITE !!,"8PM",!,"-----------------------------------------------------------------------------"
+7 KILL N
FOR K1=1:1:3
FOR K2=1:1:4
SET N(K1,K2)=""
+8 SET L=4
FOR K1=1:1:3
SET K=0
FOR K2=1:1:4
SET Z=$PIECE(Y,"^",L+1)
SET Q=$PIECE(Y,"^",L+2)
SET L=L+2
IF Z'=""
IF 'Q
SET Q=1
SET K=K+1
SET N(K1,K)=$JUSTIFY(Q,2)_" "_$PIECE($GET(^FH(118,Z,0)),"^",1)
+9 IF WARD'=""
FOR K2=1:1:4
WRITE !,N(1,K2),?26,N(2,K2),?52,N(3,K2)
+10 IF WARD=""
IF $DATA(FHMEAL)
FOR K2=1:1:4
WRITE !,$SELECT(FHMEAL="B":N(1,K2),FHMEAL="N":N(2,K2),1:N(3,K2))
+11 IF $PIECE(Y,"^",34)'=""
WRITE !!,"Diet Pattern Associated: ",$SELECT($PIECE(Y,"^",34)="Y":"YES",1:"NO")
+12 QUIT
EN2 ; Supplemental Feeding Inquiry
+1 KILL FHSFLG,FHDFN,FHPTNM,FHMEAL,ADM,NO,Y,X
+2 SET FHALL=1
DO ^FHOMDPA
IF 'FHDFN
GOTO KIL
+3 SET WARD=""
IF $GET(DFN)'=""
SET WARD=$GET(^DPT(DFN,.1))
IF WARD'=""
DO LIS
GOTO EN2
+4 IF WARD=""
DO SF
+5 IF '$GET(FHSFLG)
WRITE !,"NO OUTPATIENT DATA ON FILE for today's date and the future!!"
GOTO EN2
+6 DO SF0
+7 IF $GET(ADM)
DO LIS
GOTO EN2
+8 ;
SF ;LIST outpatient SF
+1 WRITE @IOF,!,"Outpatient Recurring Meals... "
+2 SET FHQ=0
+3 FOR FHI=DT-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
+4 SET FHDA15=$GET(^FHPT(FHDFN,"OP",FHJ,0))
+5 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
+6 SET Y=$PIECE(FHDA15,U,1)
XECUTE ^DD("DD")
SET DTP=Y
+7 SET (FHCOFLG,FHDATL,FHSF)=0
+8 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
+9 SET FHSFLG=1
+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 QUIT
+20 ;
+21 ;K DIC
+22 ;S DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-1),($P(^(0),U,15)'=""C"")"
+23 ;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"")"
+24 ;S DIC="^FHPT(FHDFN,""OP"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
SF0 ;ask for outpatient SF.
+1 KILL DIC
SET DIC(0)="AEQM"
+2 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"")"
+3 SET DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-1),($P(^(0),U,15)'=""C"")"
+4 SET DIC="^FHPT(FHDFN,""OP"","
+5 SET DIC("?")="Select a Date, '^' to exit"
+6 SET DIC("A")="Select the Outpatient Date :"
DO ^DIC
KILL DIC
IF (Y'>0)!$DATA(DTOUT)
QUIT
+7 SET ADM=+Y
+8 SET FHMEAL=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,4)
+9 QUIT
+10 ;
OIS ;Outpatient Individualized SF
+1 IF 'NM
QUIT
+2 IF '$DATA(FHX)
SET FHX="ALL"
+3 IF (FHX="ALL")!($LENGTH(FHX)=3)
SET FHIDI="BNE"
+4 IF $LENGTH(FHX)=2
SET FHIDI=$SELECT(FHX="NB":"BN",FHX="EB":"BE",FHX="EN":"NE",1:FHX)
+5 IF $LENGTH(FHX)=1
SET FHIDI=FHX
+6 FOR FHII=1,2,3
SET FHMEAL=$EXTRACT(FHIDI,FHII)
IF FHII'>0!(FHMEAL="")
QUIT
DO G0
+7 DO G6
+8 QUIT
G0 ;process each meals for individualized SF.
+1 SET T1=$SELECT(FHMEAL="B":"10am",FHMEAL="N":"2pm",1:"8pm")
+2 SET KK=$SELECT(FHMEAL="B":1,FHMEAL="N":5,1:9)
+3 ;I NM'=1 D CAN^FHNO5,ADD^FHNO5
+4 SET DIC="^FH(118,"
SET DIC(0)="EQM"
SET DIC("S")="I $P(^(0),U,3)'=""Y"""
+5 ;
G1 IF KK>12
GOTO G5
+1 IF ((WARD="")&(FHMEAL="B")&(KK>4))!((WARD="")&(FHMEAL="N")&(KK>8))
GOTO G5
+2 ;I WARD'="" S T1=$P("10am^2pm^8pm","^",KK-1\4+1)
+3 SET T2="#"_(KK-1#4+1)
SET P1=KK*2+3
+4 SET DIC("A")=T1_" Feeding "_T2_": "
+5 SET OLD=$PIECE(PNN,"^",P1)
IF OLD
SET DIC("A")=DIC("A")_$PIECE(^FH(118,+OLD,0),"^",1)_"// "
+6 ;
G2 WRITE !!,DIC("A")
READ X:DTIME
IF '$TEST!(X["^")
GOTO G5
+1 IF X=""
IF OLD
GOTO G3
SET KK=$SELECT(KK<5:5,KK<9:9,1:13)
GOTO G1
+2 IF OLD
IF X="@"
SET $PIECE(PNN,"^",P1)=""
SET $PIECE(PNN,"^",P1+1)=""
SET KK=KK+1
GOTO G1
+3 DO ^DIC
IF Y<1
GOTO G2
SET Y=+Y
SET K1=$SELECT(KK<5:1,KK<9:5,1:9)
+4 FOR L=K1:1:K1+3
IF L'=KK
IF $PIECE(PNN,"^",L*2+3)=Y
WRITE *7," .. DUPLICATE OF EXISTING ITEM!"
GOTO G2
+5 IF OLD'=Y
SET $PIECE(PNN,"^",P1)=Y
+6 ;
G3 SET OLD=$PIECE(PNN,"^",P1+1)
+1 ;
G4 WRITE !,T1," ",T2," Qty: ",$SELECT(OLD="":1,1:OLD),"// "
READ X:DTIME
IF '$TEST!(X["^")
GOTO G5
+1 IF X="@"
SET X=0
IF X=""
IF OLD=""
SET $PIECE(PNN,"^",P1+1)=1
SET KK=KK+1
GOTO G1
+2 IF X'?1N.N!(X>20)
WRITE *7," ??"
SET X="?"
+3 IF X["?"
WRITE !?5,"Enter a whole number between 1 and 20"
GOTO G4
+4 IF 'X
SET $PIECE(PNN,"^",P1)=""
SET $PIECE(PNN,"^",P1+1)=""
SET KK=KK+1
GOTO G1
+5 SET $PIECE(PNN,"^",P1+1)=X
SET KK=KK+1
GOTO G1
+6 ;
G5 SET KK=3
SET X=""
FOR T1=0:1:2
SET P1=T1*8-1
FOR T2=1:1:4
SET KK=KK+2
IF $PIECE(PNN,"^",KK)
SET P1=P1+2
SET $PIECE(X,"^",P1,P1+1)=$PIECE(PNN,"^",KK,KK+1)
+1 ;I X="" D CAN^FHNO5 Q
+2 QUIT
+3 ;
G6 SET P1=$PIECE(PNN,"^",29)
IF P1=""
SET P1="D"
WRITE !!,"Dietary or Therapeutic? ",P1,"// "
READ Y:DTIME
IF '$TEST!("^"[Y)
SET Y=P1
+1 IF $PIECE("dietary",Y,1)=""
SET Y="D"
IF $PIECE("therapeutic",Y,1)=""
SET Y="T"
+2 IF $PIECE("DIETARY",Y,1)'=""
IF $PIECE("THERAPEUTIC",Y,1)'=""
WRITE *7,!?5," Answer D for Dietary use or T for Therapeutic use"
GOTO G6
+3 SET $PIECE(X,"^",25)=$EXTRACT(Y,1)
SET PNN=$PIECE(PNN,"^",1,4)_"^"_X
+4 ;G:$P(PNO,"^",5,29)=X UPD^FHNO5 D CAN^FHNO5
+5 SET FHPNNSV=PNN
+6 SET FHIDFLG=1
+7 QUIT
+8 ;
CPRSF ;check previous SF
+1 KILL PNN
+2 SET (FHDAT,FHSF)=""
CPRS1 IF FHSF=""
SET FHSF=$ORDER(^FHPT(FHDFN,"OP",999999999),-1)
+1 IF '$TEST
SET FHSF=$ORDER(^FHPT(FHDFN,"OP",FHSF),-1)
+2 IF '$GET(FHSF)
QUIT
+3 SET FHDAT=$GET(^FHPT(FHDFN,"OP",FHSF,0))
SET FHPRML=$PIECE(FHDAT,U,4)
SET FHPRCN=$PIECE(FHDAT,U,15)
SET FHLOCN=$PIECE(FHDAT,U,3)
+4 IF (FHPRML'=FHMEAL)!(FHPRCN="C")!'$DATA(^FHPT(FHDFN,"OP",FHSF,"SF",0))
GOTO CPRS1
+5 SET FHI=$PIECE($GET(^FHPT(FHDFN,"OP",FHSF,"SF",0)),U,3)
IF FHI'>0
QUIT
+6 SET PNN=$GET(^FHPT(FHDFN,"OP",FHSF,"SF",FHI,0))
SET FHSFCX=$PIECE(PNN,U,32)
+7 IF $GET(FHSFCX)
KILL PNN
GOTO CPRS1
+8 IF $PIECE(PNN,U,34)="Y"
KILL PNN
QUIT
+9 SET $PIECE(PNN,U,3)=DUZ
SET FHNMSAV=$PIECE(PNN,U,4)
+10 QUIT
PPRSF ;PROCESS previous SF
+1 IF '$DATA(PNN)
QUIT
+2 DO NOW^%DTC
SET NOW=%
+3 DO ADDOUT^FHNO5
+4 QUIT
SFEVNT ;
+1 SET FHDTC=0
+2 SET FHLOCN=""
IF $DATA(FHLOC)
IF $GET(FHLOC)
IF $DATA(^FH(119.6,FHLOC,0))
SET FHLOCN=$PIECE(^(0),U,1)
+3 SET FHDTC=FHDTC+1
SET DTP=FHOSTDT
DO DTP^FH
IF FHDTC=1
SET FHDTP=DTP
+4 SET DTP=$PIECE(ENDT,".",1)
DO DTP^FH
+5 IF DTP'=FHDTP
SET FHDTP=FHDTP_" to "_DTP
+6 IF FHADSFF=1
SET FHACT="O"
SET FHTXT="Outpatient Supplemental Feeding: "_FHSFMEN_" ("_FHMEAL_") , "_FHLOCN_", "_FHDTP
DO OPFILE^FHORX
+7 QUIT
+8 ;
KIL GOTO KILL^XUSCLEAN
