source: FOIAVistA/trunk/r/DIETETICS-FH/FHASMR1.m@ 1163

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1FHASMR1 ; HISC/REL/NCA/JH - Assessment Report (cont) ;5/17/96 12:48
2 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
3EN ; Print Report
4 D NOW^%DTC S NOW=% K % S ANS=""
5 I '$G(ASN),$G(FHCAS) S ASN=FHCAS
6 S LN="",$P(LN,"-",80)="",PG=0,S1=$S(IOST?1"C".E:IOSL-2,1:IOSL-6) D HEAD
7 W !!,NAM,?40,$S(SEX="M":"Male",1:"Female"),?60,"Age ",AGE
8 S DTP=ADT D DTP^FH W !?25,"Date of Assessment: ",$E(DTP,1,9)
9 S (FHRDIPLD,FHRDIST,FHRDIPL,FHRDINFD,FHRDINA,FHRDINFD,FHRDINF,FHREDU,FHRDIDI,FHRDITF,FHRDITFD,FHRDITFM,FHRDITFK,FHRDITFC,FHRNWGT,FHRDNWGT,FHRFUD,FHRFEC,FHRFPC,FHRFDC)="" D DIA
10EN1 S DTP="" I FHRDIPLD S DTP=FHRDIPLD D DTP^FH
11 I $G(FH7FLG)=1 G FLG7
12 W !,"Diagnosis: ",$E(FHRDIPL,1,30)
13 S DTP="" I FHRDINFD S DTP=FHRDINFD D DTP^FH
14 W !,"Problem: ",$E(FHRDINA,1,30)
15 S DTP="" I FHRDINFD S DTP=FHRDINFD D DTP^FH
16 W !,"Additional Problem: ",$E(FHRDINF,1,30)
17 W !!,"Current Diet: ",$E(FHRDIDI,1,33)
18 I FHRDITFD'="" D
19 .W !,"Tubefeed Ordered: " S DTP=FHRDITFD D DTP^FH W DTP
20 .I ASN I $D(^FHPT(FHDFN,"N",ASN,"TF")) F FHTUN=0:0 S FHTUN=$O(^FHPT(FHDFN,"N",ASN,"TF",FHTUN)) Q:FHTUN'>0 D
21 ..S FHASTFZN=$G(^FHPT(FHDFN,"N",ASN,"TF",FHTUN,0))
22 ..S TNM=$P(FHASTFZN,U,1),STR=$P(FHASTFZN,U,2),QUA=$P(FHASTFZN,U,3)
23 ..W !?3,$P($G(^FH(118.2,TNM,0)),"^",1),", ",$S(STR=4:"Full",STR=1:"1/4",STR=2:"1/2",1:"3/4")," Str., ",QUA Q
24 .W !,"Total Quantity: ",FHRDITFM," ml",?42,"Total KCAL: ",FHRDITFK
25 .W !,"Tubefeed Comment: ",FHRDITFC
26 K FHASTFZN,FHRDIPL,FHRDIPLD,FHRDINF,FHRDINFD,FHRDIDI,FHRDITF,DTP,FHRDITFD,FHRDITFM,FHRDITFK,FHRDITFC
27FLG7 S X1=$S(HGT\12:HGT\12_"'",1:"")_$S(HGT#12:" "_(HGT#12)_"""",1:""),X2=+$J(HGT*2.54,0,0)_" cm"
28 W !!,"Height: ",$S(FHU'="M":X1,1:X2)," (",$S(FHU'="M":X2,1:X1),")" W:HGP'="" " ",$S(HGP="K":"knee hgt",HGP="S":"stated",1:"")
29 S X1=WGT_" lbs",X2=+$J(WGT/2.2,0,1)_" kg"
30 W !,"Weight: ",$S(FHU'="M":X1,1:X2)," (",$S(FHU'="M":X2,1:X1),")" W:WGP'="" " ",$S(WGP="A":"anthro",WGP="S":"stated",1:"")
31 S DTP="" I DWGT S DTP=DWGT D DTP^FH
32 W ?50,"Weight Taken: ",DTP
33 S X1=FHRNWGT_" lbs",X2=+$J(FHRNWGT/2.2,0,1)_" kg"
34 ;W !,"New Weight: ",$S(FHU'="M":X1,1:X2)," (",$S(FHU'="M":X2,1:X1),")" W:WGP'="" " ",$S(WGP="A":"anthro",WGP="S":"stated",1:"") S DTP=FHRDNWGT D DTP^FH W ?50,"New Weight Taken: ",DTP
35 K FHRNWGT,FHRDNWGT
36 I UWGT S X1=UWGT_" lbs",X2=+$J(UWGT/2.2,0,1)_" kg"
37 W !,"Usual Weight: " W:UWGT $S(FHU'="M":X1,1:X2)," (",$S(FHU'="M":X2,1:X1),")" W ?50,"% Usual Wt: " W:UWGT $J(WGT/UWGT*100,3,0),"%"
38 I '$D(IBW) S IBW=RIBW
39 S X1=IBW_" lbs",X2=+$J(IBW/2.2,0,1)_" kg"
40 W !,"Target Weight: ",$S(FHU'="M":X1,1:X2)," (",$S(FHU'="M":X2,1:X1),")" W ?50,"% Target Wt: " W:IBW $J(WGT/IBW*100,3,0),"%"
41 I AMP W !?6,"Target weight adjusted for amputation"
42 W !,"Frame Size: ",$S(FRM="S":"Small",FRM="M":"Medium",FRM="L":"Large",1:"")
43 W ?50,"Body Mass Index: ",BMI
44 ;W:BMIP'="" " (",BMIP,"% )"
45 I $G(TSF)!$G(SCA)!$G(ACIR)!$G(CCIR) S EXT="Y"
46 D:$Y'<(S1-3) HF Q:ANS="^" G:EXT'="Y" Q4 W !!?26,"Anthropometric Measurements",!?35,"%ile",?71,"%ile",!
47 W !?4,"Triceps Skinfold (mm)" I TSF W ?31,$J(+TSF,3,0),?36,$J(TSFP,3)
48 W ?43,"Arm Circumference (cm)" I ACIR W ?67,$J(+ACIR,3,0),?72,$J(ACIRP,3)
49 W !?4,"Subscapular Skinfold (mm)" I SCA W ?31,$J(+SCA,3,0),?36,$J(SCAP,3)
50 W ?43,"Bone-free AMA (cm2)" I BFAMA W ?67,$J(+BFAMA,3,0),?72,$J(BFAMAP,3)
51 W !?4,"Calf Circumference (cm)" I CCIR W ?31,$J(+CCIR,3,0),?36,$J(CCIRP,3)
52Q4 I $Y'<(S1-4) D HF Q:ANS="^"
53 W !!?32,"Laboratory Data",!?5,"Test",?30,"Result units",?51,"Ref. range",?67,"Date"
54 S N1=0 F K=0:0 S K=$O(LRTST(K)) Q:K="" D LAB
55 I 'N1 W !!?3,"No laboratory data available last ",$S($D(^FH(119.9,1,3)):$P(^(3),"^",2),1:90)," days"
56 S N=PRO/6.25 I $Y'<(S1-4) D HF Q:ANS="^"
57DRU ;pharmacy data.
58 W !!?3,"Medications"
59 S PX=1 D DRUG^FHASM4
60 I $D(PSCA) D
61 .W !
62 .F FHI=0:0 S FHI=$O(PSCA(FHI)) Q:FHI'>0 S FHJ="" F S FHJ=$O(PSCA(FHI,FHJ)) Q:FHJ="" D
63 ..W !?3,FHJ
64 W !!,"Educated on Food/Drug Interactions: ",$S(FHREDU="Y":"Yes",1:"No") K FHREDU
65 W !,"FOOD/DRUG COMMENT: ",FHRFDC
66 K FHI,FHJ,PSD,PSCA,FHRFDC
67 I $D(FHFEC),(FHFEC'="") S FHRFEC=FHFEC
68 W !!,"Energy Requirements: ",KCAL," Kcal/day" W:N ?50,"Kcal:N ",$J(KCAL/N,0,0),":1" W:NB'="" ?67,"N-Bal: ",NB
69 W:FHRFEC'="" !?3,"Energy calculation is based on: ",FHRFEC
70 I $D(FHFPC),(FHFPC'="") S FHRFPC=FHFPC
71 W !,"Protein Requirements: ",PRO," gm/day" W:N ?50,"NPC:N ",$J(KCAL-(PRO*4)/N,0,0),":1"
72 W:FHRFPC'="" !?3,"Protein calculation is based on: ",FHRFPC
73 K FHRFEC,FHRFPC
74 I FLD'="" W !,"Fluid Requirements: ",FLD," ml/day"
75 G:'PRT Q6
76 D:$Y'<(S1-4) HF Q:ANS="^" W:APP'="" !!,"Appearance: ",?20,APP
77 I XD W !,"Nutrition Class: " W ?20,$P($G(^FH(115.3,XD,0)),"^",1)
78 I RC W !,"Nutrition Status: " W ?20,$P($G(^FH(115.4,RC,0)),"^",2)
79 D DCOM
80 Q
81 ;D:$Y'<(S1-4) HF Q:ANS="^" W !!,"Comments",!
82DIA ;patch #8: adding diagnosis, follow-up date and status data.
83 ;get data from DI node.
84 ;
85 I ASN S FHDIA=$G(^FHPT(FHDFN,"N",ASN,"DI")) Q:FHDIA="" D
86 .S FHRDIPL=$P(FHDIA,U,1)
87 .S FHRDIPLD=$P(FHDIA,U,2)
88 .S FHRDINF=$P(FHDIA,U,3)
89 .S FHRDINFD=$P(FHDIA,U,4)
90 .S FHRFUD=$P(FHDIA,U,5)
91 .S FHRDIST=$P(FHDIA,U,6)
92 .S FHRDIDI=$P(FHDIA,U,7)
93 .S FHRDITFD=$P(FHDIA,U,8)
94 .S FHRDITFM=$P(FHDIA,U,10)
95 .S FHRDITFK=$P(FHDIA,U,11)
96 .S FHRDITFC=$P($G(^FHPT(FHDFN,"N",ASN,4)),U,1)
97 .S FHRFEC=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,2)
98 .S FHRFPC=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,3)
99 .S FHRDINA=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,4)
100 .S FHREDU=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,5)
101 .S FHRFDC=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,6)
102 Q
103DCOM ;print follow up date and status and comments
104 S DTP="" I FHRFUD S DTP=FHRFUD D DTP^FH
105 W !!,"Follow-up Date: ",DTP
106 W ?40,"Assessment Status: ",$S(FHRDIST="C":"Completed",FHRDIST="S":"Signed",FHRDIST="W":"Work in Progress",1:"")
107 K FHRFUD,FHRDIST
108 W !!,"Comments:"
109 I ASN F K=0:0 S K=$O(^FHPT(FHDFN,"N",ASN,"X",K)) Q:K<1 D:$Y'<S1 HF Q:ANS="^" W !,^FHPT(FHDFN,"N",ASN,"X",K,0)
110 S SIGN=$P(^FHPT(FHDFN,"N",ASN,0),U,23) W:SIGN'="" !!,"Entered by: ",$P($P(^VA(200,SIGN,0),U),",",2)," ",$P($P(^VA(200,SIGN,0),U),",")
111 G:$E(IOST)="C" Q6 F KK=1:1:IOSL-$Y-7 W !
112 S $P(UL,"-",39)="" W !?38,UL W !?38,"Signature",?68,"Date"
113Q6 D FOOT Q
114LAB S X1=$P(LRTST(K),"^",7) Q:X1="" S DTP=X1\1 D DTP^FH S N1=N1+1
115 I $Y'<S1 D HF Q:ANS="^"
116 W !?5,$P(LRTST(K),"^",1),?27,$P(LRTST(K),"^",6),?40,$P(LRTST(K),"^",4),?51,$P(LRTST(K),"^",5),?65,DTP Q
117HF ; Do Header and Footer
118 D FOOT Q:ANS="^" D HEAD
119 Q
120HEAD ; Page Header
121 I IOST?1"C".E W @IOF Q
122 W:PG @IOF S PG=PG+1,DTP=DT D DTP^FH
123 W !,LN,!,DTP,?29,"NUTRITION ASSESSMENT",?73,"Page ",PG,!,LN Q
124FOOT ; Page Footer
125 D PAUSE Q:IOST?1"C-".E
126 F KK=1:1:IOSL-$Y-5 W !
127 D SITE^FH W !,LN,!,NAM W ?(80-$L(SITE)\2),SITE,?67,"VAF 10-9034"
128 W ! W:PID'="" PID
129 I $G(DFN) 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)"
130 I 'DFN S W1="Outpatient Assesment" W ?(80-$L(W1)\2),W1,?66,"(Vice SF 509)"
131 W !,LN,! Q
132PAUSE ; Pause to Scroll
133 I IOST?1"C".E R !!,"Press RETURN to continue. ",YN:DTIME S:'$T!(YN["^") ANS="^" Q:ANS="^" I "^"'[YN W !,"Enter a RETURN to Continue." G PAUSE
134 Q
Note: See TracBrowser for help on using the repository browser.