| [613] | 1 | FHASN6 ; HISC/NCA - List Inpats By Nutrition Status Level ;3/1/95 10:58
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | EN2 ; Select Status to print
|
|---|
| 4 | K DIR S DIR(0)="SO^1:NORMAL;2:MILDLY COMPROMISED;3:MODERATELY COMPROMISED;4:SEVERELY COMPROMISED;5:UNCLASSIFIED",DIR("A")="Choose a Nutrition Status Level" D ^DIR G:$D(DIRUT)!($D(DIROUT)) KIL S STS=+Y
|
|---|
| 5 | 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
|
|---|
| 6 | S SRT=$E(X,1)
|
|---|
| 7 | L0 K IOP S %ZIS="MQ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 8 | I $D(IO("Q")) S FHPGM="Q0^FHASN6",FHLST="STS^SRT" D EN2^FH G KIL
|
|---|
| 9 | U IO D Q0 D ^%ZISC K %ZIS,IOP G FHASN6
|
|---|
| 10 | Q0 ; Process Screening
|
|---|
| 11 | K ^TMP($J)
|
|---|
| 12 | S TIT="Current Inpatients At Nutrition Status: ",ANS=""
|
|---|
| 13 | S TIT=TIT_$P("I,II,III,IV,V",",",+STS)_" "_$S(STS<5:$P($G(^FH(115.4,+STS,0)),"^",2),1:"Unclassified")
|
|---|
| 14 | 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
|
|---|
| 15 | D P0
|
|---|
| 16 | KIL K ^TMP($J) G KILL^XUSCLEAN
|
|---|
| 17 | Q1 ; Tabulate status
|
|---|
| 18 | S DTE="",X5=$O(^FHPT(FHDFN,"S",0)) G:X5="" Q2 S X5=^(X5,0)
|
|---|
| 19 | I $P(X5,"^",1)<$S($D(^FHPT(FHDFN,"A",ADM,0)):$P(^(0),"^",1),1:9999999) G Q2
|
|---|
| 20 | S S1=$P(X5,"^",2),D1=$P(X5,"^",3),DTE=$P(X5,"^",1) I S1,S1<5 G Q3
|
|---|
| 21 | Q2 ; Unclassified
|
|---|
| 22 | S S1=5,D1=WD
|
|---|
| 23 | Q3 ; Set Classification
|
|---|
| 24 | S XX=$S(SRT="W":W1,1:D1)
|
|---|
| 25 | Q4 ; Store Status
|
|---|
| 26 | I S1'=STS Q
|
|---|
| 27 | D PATNAME^FHOMUTL I DFN="" Q
|
|---|
| 28 | S X2=$G(^FHPT(FHDFN,"A",ADM,0)),RM=$P(X2,"^",9),RM=$P($G(^DG(405.4,+RM,0)),"^",1),X3=$G(^DPT(DFN,0)),PAT=$E($P(X3,"^",1),1,23) D PID^FHDPA
|
|---|
| 29 | D P1
|
|---|
| 30 | Q
|
|---|
| 31 | P0 ; Print summary
|
|---|
| 32 | D NOW^%DTC S DTP=% D DTP^FH S NOW=DTP,PG=0,LN="",$P(LN,"-",80)="" D HDR
|
|---|
| 33 | I '$D(^TMP($J)) W !!,"There are No current inpatients with ",$S(STS<5:$P($G(^FH(115.4,+STS,0)),"^",2),1:"Unclassified")," nutrition status.",!! Q
|
|---|
| 34 | W ! S NAM="" F W1=0:0 S NAM=$O(^TMP($J,NAM)) Q:NAM=""!(ANS="^") W NAM F W2=0:0 S W2=$O(^TMP($J,NAM,W2)) Q:W2<1!(ANS="^") S PAT="" D P2
|
|---|
| 35 | W ! Q
|
|---|
| 36 | P1 I SRT="W" S NAM=$E($P($G(^FH(119.6,+XX,0)),"^",1),1,15)
|
|---|
| 37 | E S NAM=$E($P($G(^VA(200,+XX,0)),"^",1),1,26)
|
|---|
| 38 | Q:NAM="" S:DTE="" DTE=$P(^FHPT(FHDFN,"A",ADM,0),"^",1) S ^TMP($J,NAM,DTE,PAT)=BID_"^"_$E(RM,1,10) Q
|
|---|
| 39 | P2 S PAT=$O(^TMP($J,NAM,W2,PAT)) Q:PAT="" S D1=$G(^(PAT))
|
|---|
| 40 | D:$Y'<(IOSL-3) HD Q:ANS="^"
|
|---|
| 41 | S BID=$P(D1,"^",1),RM=$P(D1,"^",2)
|
|---|
| 42 | W:SRT="W" ?15,RM W ?28,PAT,?53,BID,?62 S DTP=W2 D DTP^FH W DTP,!!
|
|---|
| 43 | G P2
|
|---|
| 44 | W1 ; Get ward parameters
|
|---|
| 45 | S WD=$P($G(^FH(119.6,W1,0)),"^",2) S:'WD WD=0 Q
|
|---|
| 46 | HD ; Check for end of page
|
|---|
| 47 | I IOST?1"C".E W:$X>1 ! W *7 K DIR S DIR(0)="E" D ^DIR I 'Y S ANS="^" Q
|
|---|
| 48 | HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,NOW,?72,"Page ",PG,!!?(80-$L(TIT)\2),TIT
|
|---|
| 49 | W !!,$S(SRT="W":"Ward Room",1:"Clinician"),?28,"Patient",?53,"ID#",?62,"Date Entered",!,LN,! Q
|
|---|
