FHASN ; HISC/REL - Nutrition Status ;10/29/93 08:55
;;5.5;DIETETICS;;Jan 28, 2005
EN4 ; List Nutrition Statuses
W ! S L=0,DIC="^FH(115.4,",FLDS=".01,1",BY=".01"
S (FR,TO)="",DHD="NUTRITION STATUS" D EN1^DIP,RSET Q
EN5 ; Enter Nutrition Status for Patient
S ALL=1 D ^FHDPA G:'DFN KIL
I $P($G(^DPT(DFN,.35)),"^",1) W *7,!!?5," [ Patient has expired. ]" G EN5
; If Multidivisional site Select Communications Office
S FHCOMM="" I $P($G(^FH(119.9,1,0)),U,20)'="N" D I FHCOMM="" Q
.W ! K DIC S DIC="^FH(119.73," S DIC(0)="AEMQ" D ^DIC
.I Y=-1 Q
.S FHCOMM=+Y
D DID^FHDPA,GET
K DIC S DIC="^FH(115.4,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,2)'=""""" S:Y'="" DIC("B")=Y W ! D ^DIC K DIC G KIL:"^"[X!$D(DTOUT),EN5:Y<1 I +Y'=OLD S S2="I" G C2
C1 R !!,"Is this a re-screen (Y/N)? ",X:DTIME G KIL:'$T,EN5:X["^" S:X="" X="^" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7,!," Answer YES or NO" G C1
S S2=$S(X?1"Y".E:"F",1:"I")
C2 S S1=+Y D NOW^%DTC S NOW=%
I '$D(^FHPT(FHDFN,0)) S ^(0)=FHDFN
I '$D(^FHPT(FHDFN,"S",0)) S ^(0)="^115.012D^^"
K DIC,DD,DO S DIC="^FHPT(FHDFN,""S"",",DIC(0)="L",DLAYGO=115,DA(1)=FHDFN,X=NOW,DINUM=9999999-NOW D FILE^DICN S ASE=+Y
S $P(^FHPT(FHDFN,"S",ASE,0),"^",2,3)=S1_"^"_DUZ S:FHWRD $P(^(0),"^",6)=FHWRD
S DTE=+$E(NOW,1,12),S3="Nutrition Status: "_$P(^FH(115.4,S1,0),"^",2),S1=2
D FIL^FHASE3 G EN5
GET ; Get Nutrition Status for current admission
S Y="",OLD="",X5=$O(^FHPT(FHDFN,"S",0)) Q:X5="" S X5=^(X5,0)
I WARD'="" Q:$P(X5,"^",1)<$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",1)
S OLD=+$P(X5,"^",2),Y=$P($G(^FH(115.4,OLD,0)),"^",2) K X5 Q
RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHASN 1664 printed Sep 23, 2025@19:23:01 Page 2
FHASN ; HISC/REL - Nutrition Status ;10/29/93 08:55
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN4 ; List Nutrition Statuses
+1 WRITE !
SET L=0
SET DIC="^FH(115.4,"
SET FLDS=".01,1"
SET BY=".01"
+2 SET (FR,TO)=""
SET DHD="NUTRITION STATUS"
DO EN1^DIP
DO RSET
QUIT
EN5 ; Enter Nutrition Status for Patient
+1 SET ALL=1
DO ^FHDPA
if 'DFN
GOTO KIL
+2 IF $PIECE($GET(^DPT(DFN,.35)),"^",1)
WRITE *7,!!?5," [ Patient has expired. ]"
GOTO EN5
+3 ; If Multidivisional site Select Communications Office
+4 SET FHCOMM=""
IF $PIECE($GET(^FH(119.9,1,0)),U,20)'="N"
Begin DoDot:1
+5 WRITE !
KILL DIC
SET DIC="^FH(119.73,"
SET DIC(0)="AEMQ"
DO ^DIC
+6 IF Y=-1
QUIT
+7 SET FHCOMM=+Y
End DoDot:1
IF FHCOMM=""
QUIT
+8 DO DID^FHDPA
DO GET
+9 KILL DIC
SET DIC="^FH(115.4,"
SET DIC(0)="AEQM"
SET DIC("S")="I $P(^(0),U,2)'="""""
if Y'=""
SET DIC("B")=Y
WRITE !
DO ^DIC
KILL DIC
if "^"[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO EN5
IF +Y'=OLD
SET S2="I"
GOTO C2
C1 READ !!,"Is this a re-screen (Y/N)? ",X:DTIME
if '$TEST
GOTO KIL
if X["^"
GOTO EN5
if X=""
SET X="^"
DO TR^FH
IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE *7,!," Answer YES or NO"
GOTO C1
+1 SET S2=$SELECT(X?1"Y".E:"F",1:"I")
C2 SET S1=+Y
DO NOW^%DTC
SET NOW=%
+1 IF '$DATA(^FHPT(FHDFN,0))
SET ^(0)=FHDFN
+2 IF '$DATA(^FHPT(FHDFN,"S",0))
SET ^(0)="^115.012D^^"
+3 KILL DIC,DD,DO
SET DIC="^FHPT(FHDFN,""S"","
SET DIC(0)="L"
SET DLAYGO=115
SET DA(1)=FHDFN
SET X=NOW
SET DINUM=9999999-NOW
DO FILE^DICN
SET ASE=+Y
+4 SET $PIECE(^FHPT(FHDFN,"S",ASE,0),"^",2,3)=S1_"^"_DUZ
if FHWRD
SET $PIECE(^(0),"^",6)=FHWRD
+5 SET DTE=+$EXTRACT(NOW,1,12)
SET S3="Nutrition Status: "_$PIECE(^FH(115.4,S1,0),"^",2)
SET S1=2
+6 DO FIL^FHASE3
GOTO EN5
GET ; Get Nutrition Status for current admission
+1 SET Y=""
SET OLD=""
SET X5=$ORDER(^FHPT(FHDFN,"S",0))
if X5=""
QUIT
SET X5=^(X5,0)
+2 IF WARD'=""
if $PIECE(X5,"^",1)<$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",1)
QUIT
+3 SET OLD=+$PIECE(X5,"^",2)
SET Y=$PIECE($GET(^FH(115.4,OLD,0)),"^",2)
KILL X5
QUIT
RSET KILL %ZIS
SET IOP=""
DO ^%ZIS
KILL %ZIS,IOP
KIL GOTO KILL^XUSCLEAN
