| 1 | FHASN ; HISC/REL - Nutrition Status ;10/29/93 08:55
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | EN4 ; List Nutrition Statuses
|
|---|
| 4 | W ! S L=0,DIC="^FH(115.4,",FLDS=".01,1",BY=".01"
|
|---|
| 5 | S (FR,TO)="",DHD="NUTRITION STATUS" D EN1^DIP,RSET Q
|
|---|
| 6 | EN5 ; Enter Nutrition Status for Patient
|
|---|
| 7 | S ALL=1 D ^FHDPA G:'DFN KIL
|
|---|
| 8 | I $P($G(^DPT(DFN,.35)),"^",1) W *7,!!?5," [ Patient has expired. ]" G EN5
|
|---|
| 9 | ; If Multidivisional site Select Communications Office
|
|---|
| 10 | S FHCOMM="" I $P($G(^FH(119.9,1,0)),U,20)'="N" D I FHCOMM="" Q
|
|---|
| 11 | .W ! K DIC S DIC="^FH(119.73," S DIC(0)="AEMQ" D ^DIC
|
|---|
| 12 | .I Y=-1 Q
|
|---|
| 13 | .S FHCOMM=+Y
|
|---|
| 14 | D DID^FHDPA,GET
|
|---|
| 15 | 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
|
|---|
| 16 | 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
|
|---|
| 17 | S S2=$S(X?1"Y".E:"F",1:"I")
|
|---|
| 18 | C2 S S1=+Y D NOW^%DTC S NOW=%
|
|---|
| 19 | I '$D(^FHPT(FHDFN,0)) S ^(0)=FHDFN
|
|---|
| 20 | I '$D(^FHPT(FHDFN,"S",0)) S ^(0)="^115.012D^^"
|
|---|
| 21 | 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
|
|---|
| 22 | S $P(^FHPT(FHDFN,"S",ASE,0),"^",2,3)=S1_"^"_DUZ S:FHWRD $P(^(0),"^",6)=FHWRD
|
|---|
| 23 | S DTE=+$E(NOW,1,12),S3="Nutrition Status: "_$P(^FH(115.4,S1,0),"^",2),S1=2
|
|---|
| 24 | D FIL^FHASE3 G EN5
|
|---|
| 25 | GET ; Get Nutrition Status for current admission
|
|---|
| 26 | S Y="",OLD="",X5=$O(^FHPT(FHDFN,"S",0)) Q:X5="" S X5=^(X5,0)
|
|---|
| 27 | I WARD'="" Q:$P(X5,"^",1)<$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",1)
|
|---|
| 28 | S OLD=+$P(X5,"^",2),Y=$P($G(^FH(115.4,OLD,0)),"^",2) K X5 Q
|
|---|
| 29 | RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP
|
|---|
| 30 | KIL G KILL^XUSCLEAN
|
|---|
