| 1 | FHASN3 ; HISC/NCA - Nutrition Status Matrix ;9/29/93 10:02
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | EN2 ; Select to print Change Overtime or Admission
|
|---|
| 4 | K DIR S DIR(0)="SO^1:Status Change Over a period of time;2:Status Change from Admission",DIR("A")="Select one to Display" D ^DIR G:$D(DIRUT)!($D(DIROUT)) KIL S FHX1=+Y
|
|---|
| 5 | S WRDS=$O(^FH(119.6,0)) I WRDS'<1,$O(^FH(119.6,WRDS))<1 S WRDS=0 G DT:FHX1=1,E2
|
|---|
| 6 | E1 R !!,"Select WARD (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRDS=0
|
|---|
| 7 | I X'="ALL" K DIC S DIC="^FH(119.6,",DIC(0)="EMQ" D ^DIC G KIL:$D(DTOUT),E1:Y<1 S WRDS=+Y
|
|---|
| 8 | I FHX1=2 S (SDT,EDT)="" G E2
|
|---|
| 9 | DT ; Get From/To Dates
|
|---|
| 10 | D1 K %DT S %DT="AEPX",%DT("A")="Starting Date: " W ! D ^%DT G:U[X!($D(DTOUT)) KIL G:Y<1 D1 S SDT=+Y
|
|---|
| 11 | I SDT'<DT W *7," [Must Start before Today!] " G D1
|
|---|
| 12 | D2 K %DT S %DT="AEPX",%DT("A")=" Ending Date: " D ^%DT G:U[X!($D(DTOUT)) KIL G:Y<1 D2 S EDT=+Y
|
|---|
| 13 | I EDT>DT W *7," [Greater than Today?] " G D1
|
|---|
| 14 | I EDT'>SDT W *7," [Must End after Start] " G D1
|
|---|
| 15 | S X1=EDT\1,X2=SDT\1 D ^%DTC
|
|---|
| 16 | G:'%Y!(X<1) DT
|
|---|
| 17 | S NOM=+X+1
|
|---|
| 18 | W !!,"This Report shows the status change on the starting date and on the ending date.",!,"Excludes any Admission starting from the starting date.",!
|
|---|
| 19 | G L0
|
|---|
| 20 | E2 ; Get # of Days from Admission
|
|---|
| 21 | W ! K DIR S DIR(0)="NAO^3:99",DIR("?")="The response must be a number from 3-99"
|
|---|
| 22 | S DIR("A")="Enter # of Days from Admission: "
|
|---|
| 23 | D ^DIR G:$D(DIRUT)!($D(DIROUT)) KIL S NOM=+Y
|
|---|
| 24 | L0 K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 25 | I $D(IO("Q")) S FHPGM="Q0^FHASN4",FHLST="FHX1^NOM^SDT^EDT^WRDS" D EN2^FH G KIL
|
|---|
| 26 | U IO D Q0^FHASN4 D ^%ZISC K %ZIS,IOP G KIL:'WRDS,FHASN3
|
|---|
| 27 | KIL K ^TMP($J) G KILL^XUSCLEAN
|
|---|
| 28 | HD ; Check for end of page
|
|---|
| 29 | I IOST?1"C".E W:$X>1 ! W *7 K DIR S DIR(0)="E" D ^DIR I 'Y S ANS="^" Q
|
|---|
| 30 | HDR ; Print heading
|
|---|
| 31 | W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,HD,?72,"Page ",PG
|
|---|
| 32 | W !!?9,"N U T R I T I O N S T A T U S C H A N G E M A T R I X"
|
|---|
| 33 | W !!,"WARD",?30,DTE,!,$P(NAM,"~",1)
|
|---|
| 34 | I FHX1=1 W !?17,"Shows Status Change on Start Date and End Date",!?17,"(Excludes Any Admission from the starting date)"
|
|---|
| 35 | W !!,?23,"BEG STATUS",?54,"END STATUS",?73,"STATUS"
|
|---|
| 36 | W !,"STATUS",?26,"TOTAL",?43,"I II III IV UNC SAME",!,LN,! Q
|
|---|
