- 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
