- FHASP2 ; HISC/REL - Nutrition Profile (cont.) ;10/4/93 11:44
- ;;5.5;DIETETICS;**1**;Jan 28, 2005
- S X=$P($G(^DGPM(ADM,0)),"^",10) W !,"Adm. Dx: ",$E(X,1,27)
- S X(0)=$G(^FHPT(FHDFN,"A",ADM,0))
- F1 D CUR^FHORD7 W !!,"Current Diet: ",$S(Y'="":Y,1:"No current order")
- I Y'="",FHORD>0 I $D(^FHPT(FHDFN,"A",ADM,"DI",FHORD,1)) S COM=^(1) W:COM'="" !,"Comment: ",COM
- S TYP=$P(X,"^",8) I TYP'="" W !,"Service: ",$S(TYP="T":"Tray",TYP="D":"Dining Room",1:"Cafeteria")
- S DTP=$P(X(0),"^",3) I DTP D DTP^FH W !,"Expires: ",DTP
- S TF=$P(X(0),"^",4) G:TF<1 F2
- S Y=^FHPT(FHDFN,"A",ADM,"TF",TF,0)
- S DTP=$P(Y,"^",1),COM=$P(Y,"^",5),TQU=$P(Y,"^",6),CAL=$P(Y,"^",7)
- D DTP^FH W !!,"Tubefeed Ordered: ",DTP
- F TF2=0:0 S TF2=$O(^FHPT(FHDFN,"A",ADM,"TF",TF,"P",TF2)) Q:TF2<1 S XY=^(TF2,0) D LP
- W !,"Total Quantity: ",TQU," ml",?42,"Total KCAL: ",CAL
- W:COM'="" !,"Comment: ",COM
- F2 S NO=$P(X(0),"^",7),Y=$S('NO:"",1:^FHPT(FHDFN,"A",ADM,"SF",NO,0))
- S L=$P(Y,"^",4) W !!,"Supplemental Feeding: ",$S('L:"No Order",1:$P(^FH(118.1,L,0),"^",1)) G:'NO F3
- S DTP=$P(Y,"^",30) D DTP^FH W ?50,"Reviewed: ",DTP
- S L=4 F K1=1:1:3 S K=0,N(K1)="" F K2=1:1:4 S Z=$P(Y,U,L+1),Q=$P(Y,U,L+2),L=L+2 I Z'="" S:'Q Q=1 S:N(K1)'="" N(K1)=N(K1)_"; " S N(K1)=N(K1)_Q_" "_$P(^FH(118,Z,0),"^",1)
- F K1=1:1:3 I N(K1)'="" W !?5,$P("10am; 2pm; 8pm",";",K1),":",?13,N(K1)
- F3 K CAL,TF2,TQU,X(0),XY Q
- LP S TUN=$P(XY,"^",1),STR=$P(XY,"^",2),QUA=$P(XY,"^",3)
- W !?3,$P($G(^FH(118.2,TUN,0)),"^",1),", ",$S(STR=4:"Full",STR=1:"1/4",STR=2:"1/2",1:"3/4")," Str., ",QUA Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHASP2 1540 printed Jan 18, 2025@02:48:25 Page 2
- FHASP2 ; HISC/REL - Nutrition Profile (cont.) ;10/4/93 11:44
- +1 ;;5.5;DIETETICS;**1**;Jan 28, 2005
- +2 SET X=$PIECE($GET(^DGPM(ADM,0)),"^",10)
- WRITE !,"Adm. Dx: ",$EXTRACT(X,1,27)
- +3 SET X(0)=$GET(^FHPT(FHDFN,"A",ADM,0))
- F1 DO CUR^FHORD7
- WRITE !!,"Current Diet: ",$SELECT(Y'="":Y,1:"No current order")
- +1 IF Y'=""
- IF FHORD>0
- IF $DATA(^FHPT(FHDFN,"A",ADM,"DI",FHORD,1))
- SET COM=^(1)
- if COM'=""
- WRITE !,"Comment: ",COM
- +2 SET TYP=$PIECE(X,"^",8)
- IF TYP'=""
- WRITE !,"Service: ",$SELECT(TYP="T":"Tray",TYP="D":"Dining Room",1:"Cafeteria")
- +3 SET DTP=$PIECE(X(0),"^",3)
- IF DTP
- DO DTP^FH
- WRITE !,"Expires: ",DTP
- +4 SET TF=$PIECE(X(0),"^",4)
- if TF<1
- GOTO F2
- +5 SET Y=^FHPT(FHDFN,"A",ADM,"TF",TF,0)
- +6 SET DTP=$PIECE(Y,"^",1)
- SET COM=$PIECE(Y,"^",5)
- SET TQU=$PIECE(Y,"^",6)
- SET CAL=$PIECE(Y,"^",7)
- +7 DO DTP^FH
- WRITE !!,"Tubefeed Ordered: ",DTP
- +8 FOR TF2=0:0
- SET TF2=$ORDER(^FHPT(FHDFN,"A",ADM,"TF",TF,"P",TF2))
- if TF2<1
- QUIT
- SET XY=^(TF2,0)
- DO LP
- +9 WRITE !,"Total Quantity: ",TQU," ml",?42,"Total KCAL: ",CAL
- +10 if COM'=""
- WRITE !,"Comment: ",COM
- F2 SET NO=$PIECE(X(0),"^",7)
- SET Y=$SELECT('NO:"",1:^FHPT(FHDFN,"A",ADM,"SF",NO,0))
- +1 SET L=$PIECE(Y,"^",4)
- WRITE !!,"Supplemental Feeding: ",$SELECT('L:"No Order",1:$PIECE(^FH(118.1,L,0),"^",1))
- if 'NO
- GOTO F3
- +2 SET DTP=$PIECE(Y,"^",30)
- DO DTP^FH
- WRITE ?50,"Reviewed: ",DTP
- +3 SET L=4
- FOR K1=1:1:3
- SET K=0
- SET N(K1)=""
- FOR K2=1:1:4
- SET Z=$PIECE(Y,U,L+1)
- SET Q=$PIECE(Y,U,L+2)
- SET L=L+2
- IF Z'=""
- if 'Q
- SET Q=1
- if N(K1)'=""
- SET N(K1)=N(K1)_"; "
- SET N(K1)=N(K1)_Q_" "_$PIECE(^FH(118,Z,0),"^",1)
- +4 FOR K1=1:1:3
- IF N(K1)'=""
- WRITE !?5,$PIECE("10am; 2pm; 8pm",";",K1),":",?13,N(K1)
- F3 KILL CAL,TF2,TQU,X(0),XY
- QUIT
- LP SET TUN=$PIECE(XY,"^",1)
- SET STR=$PIECE(XY,"^",2)
- SET QUA=$PIECE(XY,"^",3)
- +1 WRITE !?3,$PIECE($GET(^FH(118.2,TUN,0)),"^",1),", ",$SELECT(STR=4:"Full",STR=1:"1/4",STR=2:"1/2",1:"3/4")," Str., ",QUA
- QUIT