FHASP2.m

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

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