FHWORA1 ; HISC/GJC/JH - OE/RR Procedure Call (Assessments) 2 of 2;1/31/97 12:56 ;11/6/97 15:28
;;5.5;DIETETICS;;Jan 28, 2005
SETUP ; Set up our ^TMP($J,"FHASM",DFN) global. Called from FHWORA
S DTP=ADT D DTP^FH
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$CJ^XLFSTR("Date of Assessment: "_$E(DTP,1,9),80," ")
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
;
S X1=$S(HGT\12:HGT\12_"'",1:"")_$S(HGT#12:" "_(HGT#12)_"""",1:"")
S X2=+$J(HGT*2.54,0,0)_" cm" K STR S $P(STR," ",81)=""
S STR1="Height: "_$S(FHUNIT'="M":X1,1:X2)_" ("_$S(FHUNIT'="M":X2,1:X1)_")",TAB=0
I HGP'="" S STR1=STR1_" "_$S(HGP="K":"knee hgt",HGP="S":"stated",1:"")
S STR=$$STRING(STR,STR1,TAB)
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
;
S X1=WGT_" lbs",X2=+$J(WGT/2.2,0,1)_" kg"
S STR1="Weight: "_$S(FHUNIT'="M":X1,1:X2)_" ("_$S(FHUNIT'="M":X2,1:X1)_")",TAB=0
I WGP'="" S STR1=STR1_" "_$S(WGP="A":"anthro",WGP="S":"stated",1:"")
S STR=$$STRING(STR,STR1,TAB)
S DTP=DWGT D DTP^FH S TAB=50,STR1="Weight Taken: "_DTP
S STR=$$STRING(STR,STR1,TAB)
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
;
S (X1,X2)="" I UWGT S X1=UWGT_" lbs",X2=+$J(UWGT/2.2,0,1)_" kg"
K STR S $P(STR," ",81)="",TAB=0,STR1="Usual Weight: "_$S(FHUNIT'="M":X1,1:X2)_" ("_$S(FHUNIT'="M":X2,1:X1)_")"
S STR=$$STRING(STR,STR1,TAB)
S STR1="Weight/Usual Wt: "_$S(UWGT:($J(WGT/UWGT*100,3,0)_"%"),1:"")
S TAB=50 S STR=$$STRING(STR,STR1,TAB)
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
;
S X1=IBW_" lbs",X2=+$J(IBW/2.2,0,1)_" kg"
K STR S $P(STR," ",81)="",TAB=0
S STR1="Ideal Weight: "_$S(FHUNIT'="M":X1,1:X2)_" ("_$S(FHUNIT'="M":X2,1:X1)_")"
S STR=$$STRING(STR,STR1,TAB)
S TAB=50,STR1="Weight/IBW: "_$S(IBW:($J(WGT/IBW*100,3,0)_"%"),1:"")
S STR=$$STRING(STR,STR1,TAB)
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
;
I AMP S TAB=6 K STR S $P(STR," ",81)="",STR1="Ideal weight adjusted for amputation",STR=$$STRING(STR,STR1,TAB),^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
;
S TAB=0 K STR S $P(STR," ",81)=""
S STR1="Frame Size: "_$S(FRM="S":"Small",FRM="M":"Medium",FRM="L":"Large",1:"")
S STR=$$STRING(STR,STR1,TAB),TAB=50
S STR1="Body Mass Index: "_BMI S:BMIP'="" STR1=STR1_" ("_BMIP_"%)"
S STR=$$STRING(STR,STR1,TAB)
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
;
I FHASMNT(1)]"" D
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" " K STR
. S $P(STR," ",81)="",TAB=26
. S STR1="Anthropometric Measurements"
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$STRING(STR,STR1,TAB)
. K STR S $P(STR," ",81)=""
. S TAB=35,STR1="%ile",STR=$$STRING(STR,STR1,TAB)
. S TAB=71,STR1="%ile",STR=$$STRING(STR,STR1,TAB)
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$STRING(STR,STR1,TAB)
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
. K STR S $P(STR," ",81)="",TAB=4
. S STR1="Triceps Skinfold (mm)",STR=$$STRING(STR,STR1,TAB)
. I TSF D
.. S TAB=31,STR1=$J(+TSF,3,0),STR=$$STRING(STR,STR1,TAB)
.. S TAB=36,STR1=$J(TSFP,3),STR=$$STRING(STR,STR1,TAB)
.. Q
. S TAB=43,STR1="Arm Circumference (cm)"
. S STR=$$STRING(STR,STR1,TAB)
. I ACIR D
.. S TAB=67,STR1=$J(+ACIR,3,0),STR=$$STRING(STR,STR1,TAB)
.. S TAB=72,STR1=$J(ACIRP,3),STR=$$STRING(STR,STR1,TAB)
.. Q
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
. K STR S $P(STR," ",81)="",TAB=4,STR1="Subscapular Skinfold (mm)"
. S STR=$$STRING(STR,STR1,TAB)
. I SCA D
.. S TAB=31,STR1=$J(+SCA,3,0),STR=$$STRING(STR,STR1,TAB)
.. S TAB=36,STR1=$J(SCAP,3),STR=$$STRING(STR,STR1,TAB)
.. Q
. S TAB=43,STR1="Bone-free AMA (cm2)"
. S STR=$$STRING(STR,STR1,TAB)
. I BFAMA D
.. S TAB=67,STR1=$J(+BFAMA,3,0),STR=$$STRING(STR,STR1,TAB)
.. S TAB=72,STR1=$J(BFAMAP,3),STR=$$STRING(STR,STR1,TAB)
.. Q
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
. K STR S $P(STR," ",81)=""
. S TAB=4,STR1="Calf Circumference (cm)",STR=$$STRING(STR,STR1,TAB)
. I CCIR>0 D
.. S TAB=31,STR1=$J(+CCIR,3,0),STR=$$STRING(STR,STR1,TAB)
.. S TAB=36,STR1=$J(CCIRP,3),STR=$$STRING(STR,STR1,TAB)
.. Q
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
. Q
;
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
K STR S $P(STR," ",81)="",TAB=32,STR1="Laboratory Data"
S STR=$$STRING(STR,STR1,TAB)
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
K STR S $P(STR," ",81)="",TAB=5,STR1="Test",STR=$$STRING(STR,STR1,TAB)
S TAB=30,STR1="Result units",STR=$$STRING(STR,STR1,TAB)
S TAB=51,STR1="Ref. range",STR=$$STRING(STR,STR1,TAB)
S TAB=67,STR1="Date",STR=$$STRING(STR,STR1,TAB)
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
;
S (I,X3)=0 F S I=$O(FHLAB(I)) Q:I'>0 D LAB^FHWORA(I)
I 'X3 D
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" ",TAB=5
. K STR S $P(STR," ",81)=""
. S STR1="No laboratory data available last "_$S($D(^FH(119.9,1,3)):$P(^(3),"^",2),1:90)_" days"
. S STR=$$STRING(STR,STR1,TAB),^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
. Q
;
S N=PRO/6.25,^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" ",TAB=0
K STR S $P(STR," ",81)="",STR1="Energy Requirements: "_KCAL_" Kcal/day"
S STR=$$STRING(STR,STR1,TAB)
I N D
. S TAB=50,STR1="Kcal:N "_$J(KCAL/N,0,0)_":1"
. S STR=$$STRING(STR,STR1,TAB)
. Q
I NB'="" D
. S TAB=67,STR1="N-Bal: "_NB
. S STR=$$STRING(STR,STR1,TAB)
. Q
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
K STR S $P(STR," ",81)="",TAB=0,STR1="Protein Requirements: "_PRO_" gm/day"
S STR=$$STRING(STR,STR1,TAB)
I N D
. S TAB=50,STR1="NPC:N "_$J(KCAL-(PRO*4)/N,0,0)_":1"
. S STR=$$STRING(STR,STR1,TAB)
. Q
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
;
S:FLD'="" ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))="Fluid Requirements: "_FLD_" ml/day"
;
I FHAPPER]"" D
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
. K STR S $P(STR," ",81)="",TAB=0,STR1="Appearance: "
. S STR=$$STRING(STR,STR1,TAB)
. S TAB=20,$E(STR,(TAB+1),(TAB+$L(FHAPPER)))=FHAPPER
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
. Q
I XD D
. N Y S Y=$L($P($G(^FH(115.3,XD,0)),"^"))
. S Y(0)=$P($G(^FH(115.3,XD,0)),"^")
. S TAB=0 K STR S $P(STR," ",81)="",STR1="Nutrition Class: "
. S STR=$$STRING(STR,STR1,TAB)
. S TAB=20,$E(STR,(TAB+1),(TAB+Y))=Y(0)
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
. Q
I RC D
. N Y S Y=$L($P($G(^FH(115.4,RC,0)),"^",2))
. S Y(0)=$P($G(^FH(115.4,RC,0)),"^",2)
. S TAB=0 K STR S $P(STR," ",81)="",STR1="Nutrition Status: "
. S STR=$$STRING(STR,STR1,TAB)
. S TAB=20,$E(STR,(TAB+1),(TAB+Y))=Y(0)
. S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
. Q
D COMMENT^FHWORA ; display nutritional assessment comments
K STR S STR="" S:SIGN1'="" STR=SIGN1
K SIGN1 Q:STR=""
S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
Q
STRING(STR,STR1,TAB) ; Build our data string
S $E(STR,(TAB+1),(TAB+$L(STR1)))=STR1
Q STR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWORA1 6739 printed Sep 23, 2025@19:31:35 Page 2
FHWORA1 ; HISC/GJC/JH - OE/RR Procedure Call (Assessments) 2 of 2;1/31/97 12:56 ;11/6/97 15:28
+1 ;;5.5;DIETETICS;;Jan 28, 2005
SETUP ; Set up our ^TMP($J,"FHASM",DFN) global. Called from FHWORA
+1 SET DTP=ADT
DO DTP^FH
+2 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$CJ^XLFSTR("Date of Assessment: "_$EXTRACT(DTP,1,9),80," ")
+3 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
+4 ;
+5 SET X1=$SELECT(HGT\12:HGT\12_"'",1:"")_$SELECT(HGT#12:" "_(HGT#12)_"""",1:"")
+6 SET X2=+$JUSTIFY(HGT*2.54,0,0)_" cm"
KILL STR
SET $PIECE(STR," ",81)=""
+7 SET STR1="Height: "_$SELECT(FHUNIT'="M":X1,1:X2)_" ("_$SELECT(FHUNIT'="M":X2,1:X1)_")"
SET TAB=0
+8 IF HGP'=""
SET STR1=STR1_" "_$SELECT(HGP="K":"knee hgt",HGP="S":"stated",1:"")
+9 SET STR=$$STRING(STR,STR1,TAB)
+10 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+11 ;
+12 SET X1=WGT_" lbs"
SET X2=+$JUSTIFY(WGT/2.2,0,1)_" kg"
+13 SET STR1="Weight: "_$SELECT(FHUNIT'="M":X1,1:X2)_" ("_$SELECT(FHUNIT'="M":X2,1:X1)_")"
SET TAB=0
+14 IF WGP'=""
SET STR1=STR1_" "_$SELECT(WGP="A":"anthro",WGP="S":"stated",1:"")
+15 SET STR=$$STRING(STR,STR1,TAB)
+16 SET DTP=DWGT
DO DTP^FH
SET TAB=50
SET STR1="Weight Taken: "_DTP
+17 SET STR=$$STRING(STR,STR1,TAB)
+18 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+19 ;
+20 SET (X1,X2)=""
IF UWGT
SET X1=UWGT_" lbs"
SET X2=+$JUSTIFY(UWGT/2.2,0,1)_" kg"
+21 KILL STR
SET $PIECE(STR," ",81)=""
SET TAB=0
SET STR1="Usual Weight: "_$SELECT(FHUNIT'="M":X1,1:X2)_" ("_$SELECT(FHUNIT'="M":X2,1:X1)_")"
+22 SET STR=$$STRING(STR,STR1,TAB)
+23 SET STR1="Weight/Usual Wt: "_$SELECT(UWGT:($JUSTIFY(WGT/UWGT*100,3,0)_"%"),1:"")
+24 SET TAB=50
SET STR=$$STRING(STR,STR1,TAB)
+25 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+26 ;
+27 SET X1=IBW_" lbs"
SET X2=+$JUSTIFY(IBW/2.2,0,1)_" kg"
+28 KILL STR
SET $PIECE(STR," ",81)=""
SET TAB=0
+29 SET STR1="Ideal Weight: "_$SELECT(FHUNIT'="M":X1,1:X2)_" ("_$SELECT(FHUNIT'="M":X2,1:X1)_")"
+30 SET STR=$$STRING(STR,STR1,TAB)
+31 SET TAB=50
SET STR1="Weight/IBW: "_$SELECT(IBW:($JUSTIFY(WGT/IBW*100,3,0)_"%"),1:"")
+32 SET STR=$$STRING(STR,STR1,TAB)
+33 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+34 ;
+35 IF AMP
SET TAB=6
KILL STR
SET $PIECE(STR," ",81)=""
SET STR1="Ideal weight adjusted for amputation"
SET STR=$$STRING(STR,STR1,TAB)
SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+36 ;
+37 SET TAB=0
KILL STR
SET $PIECE(STR," ",81)=""
+38 SET STR1="Frame Size: "_$SELECT(FRM="S":"Small",FRM="M":"Medium",FRM="L":"Large",1:"")
+39 SET STR=$$STRING(STR,STR1,TAB)
SET TAB=50
+40 SET STR1="Body Mass Index: "_BMI
if BMIP'=""
SET STR1=STR1_" ("_BMIP_"%)"
+41 SET STR=$$STRING(STR,STR1,TAB)
+42 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+43 ;
+44 IF FHASMNT(1)]""
Begin DoDot:1
+45 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
KILL STR
+46 SET $PIECE(STR," ",81)=""
SET TAB=26
+47 SET STR1="Anthropometric Measurements"
+48 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$STRING(STR,STR1,TAB)
+49 KILL STR
SET $PIECE(STR," ",81)=""
+50 SET TAB=35
SET STR1="%ile"
SET STR=$$STRING(STR,STR1,TAB)
+51 SET TAB=71
SET STR1="%ile"
SET STR=$$STRING(STR,STR1,TAB)
+52 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$STRING(STR,STR1,TAB)
+53 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
+54 KILL STR
SET $PIECE(STR," ",81)=""
SET TAB=4
+55 SET STR1="Triceps Skinfold (mm)"
SET STR=$$STRING(STR,STR1,TAB)
+56 IF TSF
Begin DoDot:2
+57 SET TAB=31
SET STR1=$JUSTIFY(+TSF,3,0)
SET STR=$$STRING(STR,STR1,TAB)
+58 SET TAB=36
SET STR1=$JUSTIFY(TSFP,3)
SET STR=$$STRING(STR,STR1,TAB)
+59 QUIT
End DoDot:2
+60 SET TAB=43
SET STR1="Arm Circumference (cm)"
+61 SET STR=$$STRING(STR,STR1,TAB)
+62 IF ACIR
Begin DoDot:2
+63 SET TAB=67
SET STR1=$JUSTIFY(+ACIR,3,0)
SET STR=$$STRING(STR,STR1,TAB)
+64 SET TAB=72
SET STR1=$JUSTIFY(ACIRP,3)
SET STR=$$STRING(STR,STR1,TAB)
+65 QUIT
End DoDot:2
+66 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+67 KILL STR
SET $PIECE(STR," ",81)=""
SET TAB=4
SET STR1="Subscapular Skinfold (mm)"
+68 SET STR=$$STRING(STR,STR1,TAB)
+69 IF SCA
Begin DoDot:2
+70 SET TAB=31
SET STR1=$JUSTIFY(+SCA,3,0)
SET STR=$$STRING(STR,STR1,TAB)
+71 SET TAB=36
SET STR1=$JUSTIFY(SCAP,3)
SET STR=$$STRING(STR,STR1,TAB)
+72 QUIT
End DoDot:2
+73 SET TAB=43
SET STR1="Bone-free AMA (cm2)"
+74 SET STR=$$STRING(STR,STR1,TAB)
+75 IF BFAMA
Begin DoDot:2
+76 SET TAB=67
SET STR1=$JUSTIFY(+BFAMA,3,0)
SET STR=$$STRING(STR,STR1,TAB)
+77 SET TAB=72
SET STR1=$JUSTIFY(BFAMAP,3)
SET STR=$$STRING(STR,STR1,TAB)
+78 QUIT
End DoDot:2
+79 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+80 KILL STR
SET $PIECE(STR," ",81)=""
+81 SET TAB=4
SET STR1="Calf Circumference (cm)"
SET STR=$$STRING(STR,STR1,TAB)
+82 IF CCIR>0
Begin DoDot:2
+83 SET TAB=31
SET STR1=$JUSTIFY(+CCIR,3,0)
SET STR=$$STRING(STR,STR1,TAB)
+84 SET TAB=36
SET STR1=$JUSTIFY(CCIRP,3)
SET STR=$$STRING(STR,STR1,TAB)
+85 QUIT
End DoDot:2
+86 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+87 QUIT
End DoDot:1
+88 ;
+89 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
+90 KILL STR
SET $PIECE(STR," ",81)=""
SET TAB=32
SET STR1="Laboratory Data"
+91 SET STR=$$STRING(STR,STR1,TAB)
+92 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+93 KILL STR
SET $PIECE(STR," ",81)=""
SET TAB=5
SET STR1="Test"
SET STR=$$STRING(STR,STR1,TAB)
+94 SET TAB=30
SET STR1="Result units"
SET STR=$$STRING(STR,STR1,TAB)
+95 SET TAB=51
SET STR1="Ref. range"
SET STR=$$STRING(STR,STR1,TAB)
+96 SET TAB=67
SET STR1="Date"
SET STR=$$STRING(STR,STR1,TAB)
+97 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+98 ;
+99 SET (I,X3)=0
FOR
SET I=$ORDER(FHLAB(I))
if I'>0
QUIT
DO LAB^FHWORA(I)
+100 IF 'X3
Begin DoDot:1
+101 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
SET TAB=5
+102 KILL STR
SET $PIECE(STR," ",81)=""
+103 SET STR1="No laboratory data available last "_$SELECT($DATA(^FH(119.9,1,3)):$PIECE(^(3),"^",2),1:90)_" days"
+104 SET STR=$$STRING(STR,STR1,TAB)
SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+105 QUIT
End DoDot:1
+106 ;
+107 SET N=PRO/6.25
SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
SET TAB=0
+108 KILL STR
SET $PIECE(STR," ",81)=""
SET STR1="Energy Requirements: "_KCAL_" Kcal/day"
+109 SET STR=$$STRING(STR,STR1,TAB)
+110 IF N
Begin DoDot:1
+111 SET TAB=50
SET STR1="Kcal:N "_$JUSTIFY(KCAL/N,0,0)_":1"
+112 SET STR=$$STRING(STR,STR1,TAB)
+113 QUIT
End DoDot:1
+114 IF NB'=""
Begin DoDot:1
+115 SET TAB=67
SET STR1="N-Bal: "_NB
+116 SET STR=$$STRING(STR,STR1,TAB)
+117 QUIT
End DoDot:1
+118 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+119 KILL STR
SET $PIECE(STR," ",81)=""
SET TAB=0
SET STR1="Protein Requirements: "_PRO_" gm/day"
+120 SET STR=$$STRING(STR,STR1,TAB)
+121 IF N
Begin DoDot:1
+122 SET TAB=50
SET STR1="NPC:N "_$JUSTIFY(KCAL-(PRO*4)/N,0,0)_":1"
+123 SET STR=$$STRING(STR,STR1,TAB)
+124 QUIT
End DoDot:1
+125 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+126 ;
+127 if FLD'=""
SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))="Fluid Requirements: "_FLD_" ml/day"
+128 ;
+129 IF FHAPPER]""
Begin DoDot:1
+130 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
+131 KILL STR
SET $PIECE(STR," ",81)=""
SET TAB=0
SET STR1="Appearance: "
+132 SET STR=$$STRING(STR,STR1,TAB)
+133 SET TAB=20
SET $EXTRACT(STR,(TAB+1),(TAB+$LENGTH(FHAPPER)))=FHAPPER
+134 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+135 QUIT
End DoDot:1
+136 IF XD
Begin DoDot:1
+137 NEW Y
SET Y=$LENGTH($PIECE($GET(^FH(115.3,XD,0)),"^"))
+138 SET Y(0)=$PIECE($GET(^FH(115.3,XD,0)),"^")
+139 SET TAB=0
KILL STR
SET $PIECE(STR," ",81)=""
SET STR1="Nutrition Class: "
+140 SET STR=$$STRING(STR,STR1,TAB)
+141 SET TAB=20
SET $EXTRACT(STR,(TAB+1),(TAB+Y))=Y(0)
+142 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+143 QUIT
End DoDot:1
+144 IF RC
Begin DoDot:1
+145 NEW Y
SET Y=$LENGTH($PIECE($GET(^FH(115.4,RC,0)),"^",2))
+146 SET Y(0)=$PIECE($GET(^FH(115.4,RC,0)),"^",2)
+147 SET TAB=0
KILL STR
SET $PIECE(STR," ",81)=""
SET STR1="Nutrition Status: "
+148 SET STR=$$STRING(STR,STR1,TAB)
+149 SET TAB=20
SET $EXTRACT(STR,(TAB+1),(TAB+Y))=Y(0)
+150 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+151 QUIT
End DoDot:1
+152 ; display nutritional assessment comments
DO COMMENT^FHWORA
+153 KILL STR
SET STR=""
if SIGN1'=""
SET STR=SIGN1
+154 KILL SIGN1
if STR=""
QUIT
+155 SET ^TMP($JOB,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
+156 QUIT
STRING(STR,STR1,TAB) ; Build our data string
+1 SET $EXTRACT(STR,(TAB+1),(TAB+$LENGTH(STR1)))=STR1
+2 QUIT STR
