source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHASN.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 1.6 KB
RevLine 
[613]1FHASN ; HISC/REL - Nutrition Status ;10/29/93 08:55
2 ;;5.5;DIETETICS;;Jan 28, 2005
3EN4 ; 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
6EN5 ; 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
16C1 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")
18C2 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
25GET ; 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
29RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP
30KIL G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.