FHASN.m

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

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