- 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 Mar 13, 2025@21:00:14 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
