source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHASMR.m@ 701

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1FHASMR ; HISC/REL/NCA - Assessment Report ;4/25/93 18:46
2 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
3 S FHALL=1 D ^FHOMDPA G:'FHDFN KIL
4 I '$D(^FHPT(FHDFN,"N",0)) W !!,"No Nutrition Assessments on file" G KIL
5 ;K DIC S DIC="^FHPT(FHDFN,""N"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
6 W ! F FHNIEN=0:0 S FHNIEN=$O(^FHPT(FHDFN,"N","B",FHNIEN)) Q:FHNIEN'>0 D
7 .S FHNRV=$O(^FHPT(FHDFN,"N","B",FHNIEN,"")) Q:FHNRV'>0
8 .S Y=$P($G(^FHPT(FHDFN,"N",FHNRV,0)),U,1) D DD^%DT W !?3,Y
9 .S FHNASS=$P($G(^FHPT(FHDFN,"N",FHNRV,"DI")),U,6)
10 .W ?25,$S(FHNASS="C":"Completed",FHNASS="S":"Signed",FHNASS="W":"Work in Progress",1:"")
11A0 S DIC="^FHPT(FHDFN,""N"",",DIC(0)="AEQM",DIC("A")="SELECT Assessment Date: " W ! D ^DIC G KIL:"^"[X!$D(DTOUT),A0:Y<1 S ASN=+Y
12P0 ; Select Device
13 K IOP S %ZIS="MQ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
14 I $D(IO("Q")) S FHPGM="Q1^FHASMR",FHLST="FHDFN^DFN^PID^ASN" D EN2^FH G KIL
15 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
16Q1 ; Process Printing Assessment
17 D PATNAME^FHOMUTL
18 S NAM=FHPTNM
19 S %DT="XT",X="NOW" D ^%DT S DT=Y\1,DTP=+Y D DTP^FH S NOW=DTP
20 ;S NAM=$P(^DPT(DFN,0),"^",1)
21 S FHAP=$G(^FH(119.9,1,3)),FHU=$P(FHAP,"^",1)
22 S Y=^FHPT(FHDFN,"N",ASN,0)
23 F K=1:1:22 S @$P("ADT SEX AGE HGT HGP WGT WGP DWGT UWGT RIBW FRM AMP X X X KCAL PRO FLD RC XD BMI BMIP"," ",K)=$P(Y,"^",K)
24 S NB=$P(Y,"^",25)
25 S EXT="" I $D(^FHPT(FHDFN,"N",ASN,1)) S Y=^(1) F K=1:1:10 S @$P("TSF TSFP SCA SCAP ACIR ACIRP CCIR CCIRP BFAMA BFAMAP"," ",K)=$P(Y,"^",K)
26 S APP=$G(^FHPT(FHDFN,"N",ASN,2))
27 K LRTST F K=0:0 S K=$O(^FHPT(FHDFN,"N",ASN,"L",K)) Q:K<1 S LRTST(K)=^(K,0)
28 S PRT=1 G ^FHASMR1
29KIL ; Final variable kill
30 ;quit if calls from enter/edit assessment
31 Q:$D(FHASK)
32 G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.