31 lines
1.6 KiB
Mathematica
31 lines
1.6 KiB
Mathematica
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
|