| 1 | FHASN1 ; HISC/REL - Print Status Summary ;5/14/93 10:12
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | F0 R !!,"Print by CLINICIAN or WARD? WARD// ",X:DTIME G:'$T!(X["^") KIL S:X="" X="W" D TR^FH I $P("CLINICIAN",X,1)'="",$P("WARD",X,1)'="" W *7," Answer with C or W" G F0
|
|---|
| 4 | S SRT=$E(X,1)
|
|---|
| 5 | L0 K IOP S %ZIS="MQ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 6 | I $D(IO("Q")) S FHPGM="Q0^FHASN1",FHLST="SRT" D EN2^FH G KIL
|
|---|
| 7 | U IO D Q0 D ^%ZISC K %ZIS,IOP G KIL
|
|---|
| 8 | Q0 ; Process Screening
|
|---|
| 9 | K S
|
|---|
| 10 | F W1=0:0 S W1=$O(^FH(119.6,W1)) Q:W1'>0 D W1 F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",W1,FHDFN)) Q:FHDFN<1 S ADM=$G(^FHPT("AW",W1,FHDFN)) Q:ADM<1 D Q1
|
|---|
| 11 | G P0
|
|---|
| 12 | Q1 ; Tabulate status
|
|---|
| 13 | S X5=$O(^FHPT(FHDFN,"S",0)) G:X5="" Q2 S X5=^(X5,0)
|
|---|
| 14 | I $P(X5,"^",1)<$S($D(^FHPT(FHDFN,"A",ADM,0)):$P(^(0),"^",1),1:9999999) G Q2
|
|---|
| 15 | S S1=$P(X5,"^",2),D1=$P(X5,"^",3) I S1,S1<5 G Q3
|
|---|
| 16 | Q2 ; Unclassified
|
|---|
| 17 | S S1=5,D1=WD
|
|---|
| 18 | Q3 ; Set Classification
|
|---|
| 19 | S X=$S(SRT="W":W1,1:D1) S:'$D(S(X)) S(X)="" S $P(S(X),"^",S1)=$P(S(X),"^",S1)+1 Q
|
|---|
| 20 | P0 ; Print summary
|
|---|
| 21 | D NOW^%DTC S (NOW,DTP)=% D DTP^FH S PG=0,LN="",$P(LN,"-",66)="" D HDR
|
|---|
| 22 | K ^TMP($J) F W1=0:0 S W1=$O(S(W1)) Q:W1="" D P1
|
|---|
| 23 | S NAM="" F W1=0:0 S NAM=$O(^TMP($J,NAM)) Q:NAM="" S D1=^(NAM) D P2
|
|---|
| 24 | W ! Q
|
|---|
| 25 | P1 I SRT="W" S NAM=$P($G(^FH(119.6,W1,0)),"^",1)
|
|---|
| 26 | E S NAM=$P($G(^VA(200,W1,0)),"^",1)
|
|---|
| 27 | Q:NAM="" S ^TMP($J,NAM_"~"_W1)=S(W1) Q
|
|---|
| 28 | P2 D:$Y>(IOSL-8) HDR W !?7,$P(NAM,"~",1),?37 F K=1:1:5 S X=$P(D1,"^",K) W $J(X,7)
|
|---|
| 29 | Q
|
|---|
| 30 | W1 ; Get ward parameters
|
|---|
| 31 | S WD=$P($G(^FH(119.6,W1,0)),"^",2) S:'WD WD=0 Q
|
|---|
| 32 | HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !?16,"N U T R I T I O N S T A T U S S U M M A R Y",?73,"Page ",PG
|
|---|
| 33 | W !!?(80-$L(DTP)\2),DTP
|
|---|
| 34 | W !!?7,$S(SRT="C":"CLINICIAN",1:"WARD"),?43,"I II III IV UNC",!?7,LN,! Q
|
|---|
| 35 | KIL K ^TMP($J) G KILL^XUSCLEAN
|
|---|
