source: FOIAVistA/tag/r/DIETETICS-FH/FHASXR1.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1FHASXR1 ; HISC/REL - Print Screening (cont) ;4/20/95 08:53
2 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
3Q1 ; Print assessment
4 I $G(DFN)="" Q
5 S X="T",%DT="X" D ^%DT S DT=Y,Y=^DPT(DFN,0),NAM=$P(Y,"^",1),SEX=$P(Y,"^",2),DOB=$P(Y,"^",3)
6 S AGE=$E(DT,1,3)-$E(DOB,1,3)-($E(DT,4,7)<$E(DOB,4,7)) D PID^FHDPA
7 S FHAP=$G(^FH(119.9,1,3)),FHU=$P(FHAP,"^",1)
8 S LN="",$P(LN,"-",80)="",PG=0,S1=$S(IOST?1"C".E:IOSL-2,1:IOSL-6) D HEAD
9 S UL="",$P(UL,"_",80)="",ANS=""
10 W !!,"S: Chewing Problems: Y N",?41,"Pre-Admission Diet: ",$E(UL,1,18)
11 W !?4,"Dysphagia: Y N",?41,"Wt. + - ____ # in last ___ months"
12 W !?4,"Appetite: + -",?41,"Nausea: Y N",?58,"Vomiting: Y N"
13 W !?4,"Feeding Assistance Required: Y N",?41,"Diarrhea: Y N",?58,"Constipation: Y N"
14 D ALG^FHCLN W !?4,"Food Allergies: " S ALG=$S(ALG="":"None on file",1:ALG) D LNE
15 I $P(FHAP,"^",5)'="" W !?4,$P(FHAP,"^",5)
16Q2 W !!,"O: Current Diet: " G:WARD="" Q21 I $D(^FHPT(FHDFN,"A",ADM,0)) D CUR^FHORD7 W Y
17 S X(0)=$G(^FHPT(FHDFN,"A",ADM,0))
18 I Y'="",FHORD>0 I $D(^FHPT(FHDFN,"A",ADM,"DI",FHORD,1)) S COM=^(1) W:COM'="" !?4,"Comment: ",COM
19 S TYP=$P(X,"^",8) I TYP'="" W !?4,"Service: ",$S(TYP="T":"Tray",TYP="D":"Dining Room",1:"Cafeteria")
20 S DTP=$P(X(0),"^",3) I DTP D DTP^FH W !?4,"Expires: ",DTP
21 S TF=$P(X(0),"^",4) G:TF<1 F2
22 S Y=^FHPT(FHDFN,"A",ADM,"TF",TF,0)
23 S DTP=$P(Y,"^",1),COM=$P(Y,"^",5),TQU=$P(Y,"^",6),CAL=$P(Y,"^",7)
24 D DTP^FH W !?4,"Tubefeed Ordered: ",DTP
25 F TF2=0:0 S TF2=$O(^FHPT(FHDFN,"A",ADM,"TF",TF,"P",TF2)) Q:TF2<1 S XY=^(TF2,0) D LP
26 W !?4,"Total Quantity: ",TQU," ml",?42,"Total KCAL: ",CAL
27 W:COM'="" !?4,"Comment: ",COM
28F2 S X=$P($G(^DGPM(ADM,0)),"^",10) W !?4,"Adm. Dx: ",$E(X,1,27)
29 S DTP=$P($G(^DGPM(ADM,0)),"^",1) D DTP^FH W ?41,"Adm. Date: ",?59,DTP
30Q21 W !?4,"Age: ",AGE,?18,"Sex: ",SEX,?41,"Prior Assessment:" S ASN=$O(^FHPT(FHDFN,"N",0)) I ASN>0 S DTP=9999999-ASN D DTP^FH W ?59,DTP
31 S Y=$S(ASN>0:^FHPT(FHDFN,"N",ASN,0),1:"")
32 S HGT=$P(Y,"^",4),WGT=$P(Y,"^",6),DWGT=$P(Y,"^",8),UWGT=$P(Y,"^",9),IBW=$P(Y,"^",10),FRM=$P(Y,"^",11),AMP=$P(Y,"^",12),HGP=$P(Y,"^",5),WGP=$P(Y,"^",7)
33 I HGT'="" S X1=$S(HGT\12:HGT\12_"'",1:"")_$S(HGT#12:" "_(HGT#12)_"""",1:""),X2=+$J(HGT*2.54,0,0)_" cm"
34 S (FHHT,FHWWT,FHDWT,FHX1,FHX2)=""
35 I DFN S GMRVSTR="WT" D EN6^GMRVUTL S FHDWT=$P(X,"^",1),FHWWT=$P(X,"^",8),GMRVSTR="HT" D EN6^GMRVUTL S FHHT=$P(X,"^",8)
36 I FHHT'="" S FHX1=$S(FHHT\12:FHHT\12_"'",1:"")_$S(FHHT#12:" "_(FHHT#12)_"""",1:""),FHX2=+$J(FHHT*2.54,0,0)_" cm"
37 W !?4,"Vitals Height:",?18 W:FHX2'="" FHX2
38 W:FHX1'="" " (",FHX1,")"
39 S (FHX1,FHX2)=""
40 W ?41,"Frame Size:",?59,$S(FRM="S":"Small",FRM="M":"Medium",FRM="L":"Large",1:"")
41 I FHWWT'="" S FHX1=FHWWT_" lbs",FHX2=+$J(FHWWT/2.2,0,1)_" kg"
42 W !?4,"Vitals Weight:" W:FHX2'="" ?18,FHX2 W:FHX1'="" " (",FHX1,")"
43 W ?41,"Weight Taken:"
44 S DTP=""
45 I FHDWT'="" S DTP=FHDWT D DTP^FH
46 W ?59,DTP
47 S DTP=DWGT D:DTP'="" DTP^FH
48 ;W ?41,"Amputation %:",?59,AMP
49 S (X1,X2)=""
50 I WGT'="" S X1=WGT_" lbs",X2=+$J(WGT/2.2,0,1)_" kg"
51 W !?4,"Last Weight:" I WGT'="" W ?18,X2 W:WGP'="" " ",WGP W " (",X1,")"
52 W ?41,"Weight Taken:"
53 S DTP=DWGT D DTP^FH W:WGT'="" ?59,DTP
54 I UWGT'="" S X1=UWGT_" lbs",X2=+$J(UWGT/2.2,0,1)_" kg"
55 W !?4,"Usual Weight:" I UWGT'="" W ?18,X2," (",X1,")"
56 W ?41,"Last Weight/Usual Wt: " W:UWGT ?59,$J(WGT/UWGT*100,3,0),"%"
57 I IBW'="" S X1=IBW_" lbs",X2=+$J(IBW/2.2,0,1)_" kg"
58 W !?4,"Target Weight:" I IBW'="" W ?18,X2," (",X1,")"
59 W ?41,"Last Weight/TBW:" W:IBW ?59,$J(WGT/IBW*100,3,0),"%"
60 S BMI=""
61 I FHWWT,FHHT S A2=FHHT*.0254,BMI=+$J(FHWWT/2.2/(A2*A2),0,1)
62 W !?4,"Body Mass Index: ",BMI,?41,"Amputation %:",?59,AMP
63Q3 S PX=4 D LAB^FHASM4
64 W !!?32,"Laboratory Data",!?5,"Test",?30,"Result units",?51,"Ref. range",?67,"Date",!
65 S N1=0 F K=0:0 S K=$O(LRTST(K)) Q:K="" D LAB
66 I 'N1 W !?5,"No laboratory data available last ",$S($D(^FH(119.9,1,3)):$P(^(3),"^",2),1:90)," days"
67Q6 W !!?4,"Appearance: "
68 W !!,"A: Nutrition Status",?48,"Nutrition Education",!
69 S E(1)="Further Education Required: Y N",E(2)=$E(UL,1,31)
70 S N=0 F KK=0:0 S KK=$O(^FH(115.4,KK)) Q:KK<1&(N>1) S N=N+1 W !?4 W:$P($G(^FH(115.4,+KK,0)),"^",2)'="" "___ ",$P(^(0),"^",2) W:N<3 ?48,E(N)
71 W !?4,"Comments:"
72 W !!,"P: Nutrition Plan",!
73 F KK=0:0 S KK=$O(^FH(115.5,KK)) Q:KK<1 W !?4,"___ ",$P(^(KK,0),"^",1)
74 W !?4,"Recommendations:" F KK=1:1:IOSL-$Y-7 W !
75 W !?41,$E(UL,1,38)
76 W !?41,"Signature",?68,"Date"
77 D FOOT Q:'NP!(ANS="^") W:$E(IOST,1,2)'="C-" @IOF D Q0^FHASP Q
78LAB S X1=$P(LRTST(K),"^",7) Q:X1="" S DTP=X1\1 D DTP^FH S N1=N1+1
79 W !?5,$P(LRTST(K),"^",1),?27,$P(LRTST(K),"^",6),?40,$P(LRTST(K),"^",4),?51,$P(LRTST(K),"^",5),?65,DTP Q
80LNE ; Break Line if longer than 56 chars
81 I $L(ALG)<57 W ALG Q
82 F L=58:-1:1 Q:$E(ALG,L-1,L)=", "
83 W $E(ALG,1,L-2)
84 S ALG=$E(ALG,L+1,999)
85 Q:ALG="" W !?20
86 G LNE
87HEAD ; Page Header
88 W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1,DTP=DT D DTP^FH
89 W !,LN,!,DTP,?30,"NUTRITION SCREENING",?73,"Page ",PG,!,LN Q
90FOOT ; Page Footer
91 D PAUSE Q:IOST?1"C".E
92 F KK=1:1:IOSL-$Y-5 W !
93 D SITE^FH W !,LN,!,NAM W ?(80-$L(SITE)\2),SITE,?67,"VAF 10-9034"
94 W ! W:PID'="" PID
95 S W1=$G(^DPT(DFN,.1)) S:$D(^DPT(DFN,.101)) W1=W1_"/"_^DPT(DFN,.101) W:W1'="" ?(80-$L(W1)\2),W1,?66,"(Vice SF 509)"
96 W !,LN,! Q
97PAUSE ; Pause to Scroll
98 I IOST?1"C".E R !!,"Press RETURN to continue." R X:DTIME S:'$T!(X["^") ANS="^" Q:ANS="^" I "^"'[X W !,"Enter a RETURN to Continue." G PAUSE
99 Q
100LP S TUN=$P(XY,"^",1),STR=$P(XY,"^",2),QUA=$P(XY,"^",3)
101 W !?7,$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
Note: See TracBrowser for help on using the repository browser.