FHASN3.m

FHASN3 ; HISC/NCA - Nutrition Status Matrix ;9/29/93  10:02

 ;;5.5;DIETETICS;;Jan 28, 2005

EN2 ; Select to print Change Overtime or Admission

 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

 S WRDS=$O(^FH(119.6,0)) I WRDS'<1,$O(^FH(119.6,WRDS))<1 S WRDS=0 G DT:FHX1=1,E2

E1 R !!,"Select WARD (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRDS=0

 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

 I FHX1=2 S (SDT,EDT)="" G E2

DT ; Get From/To Dates

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

 I SDT'<DT W *7,"  [Must Start before Today!] " G D1

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

 I EDT>DT W *7,"  [Greater than Today?] " G D1

 I EDT'>SDT W *7,"  [Must End after Start] " G D1

 S X1=EDT\1,X2=SDT\1 D ^%DTC

 G:'%Y!(X<1) DT

 S NOM=+X+1

 W !!,"This Report shows the status change on the starting date and on the ending date.",!,"Excludes any Admission starting from the starting date.",!

 G L0

E2 ; Get # of Days from Admission

 W ! K DIR S DIR(0)="NAO^3:99",DIR("?")="The response must be a number from 3-99"

 S DIR("A")="Enter # of Days from Admission: "

 D ^DIR G:$D(DIRUT)!($D(DIROUT)) KIL S NOM=+Y

L0 K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) S FHPGM="Q0^FHASN4",FHLST="FHX1^NOM^SDT^EDT^WRDS" D EN2^FH G KIL

 U IO D Q0^FHASN4 D ^%ZISC K %ZIS,IOP G KIL:'WRDS,FHASN3

KIL K ^TMP($J) G KILL^XUSCLEAN

HD ; Check for end of page

 I IOST?1"C".E W:$X>1 ! W *7 K DIR S DIR(0)="E" D ^DIR I 'Y S ANS="^" Q

HDR ; Print heading

 W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !,HD,?72,"Page ",PG

 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"

 W !!,"WARD",?30,DTE,!,$P(NAM,"~",1)

 I FHX1=1 W !?17,"Shows Status Change on Start Date and End Date",!?17,"(Excludes Any Admission from the starting date)"

 W !!,?23,"BEG STATUS",?54,"END STATUS",?73,"STATUS"

 W !,"STATUS",?26,"TOTAL",?43,"I     II    III     IV    UNC   SAME",!,LN,! Q

FHASN3    ; HISC/NCA - Nutrition Status Matrix ;9/29/93  10:02

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

EN2       ; Select to print Change Overtime or Admission

 +1        KILL DIR

           SET DIR(0)="SO^1:Status Change Over a period of time;2:Status Change from Admission"

           SET DIR("A")="Select one to Display"

           DO ^DIR

           IF $DATA(DIRUT)!($DATA(DIROUT))

               GOTO KIL

           SET FHX1=+Y

 +2        SET WRDS=$ORDER(^FH(119.6,0))

           IF WRDS'<1

               IF $ORDER(^FH(119.6,WRDS))<1

                   SET WRDS=0

                   IF FHX1=1

                       GOTO DT

                   GOTO E2

E1         READ !!,"Select WARD (or ALL): ",X:DTIME

           IF '$TEST!("^"[X)

               GOTO KIL

           IF X="all"

               DO TR^FH

           IF X="ALL"

               SET WRDS=0

 +1        IF X'="ALL"

               KILL DIC

               SET DIC="^FH(119.6,"

               SET DIC(0)="EMQ"

               DO ^DIC

               IF $DATA(DTOUT)

                   GOTO KIL

               IF Y<1

                   GOTO E1

               SET WRDS=+Y

 +2        IF FHX1=2

               SET (SDT,EDT)=""

               GOTO E2

DT        ; Get From/To Dates

D1         KILL %DT

           SET %DT="AEPX"

           SET %DT("A")="Starting Date: "

           WRITE !

           DO ^%DT

           IF U[X!($DATA(DTOUT))

               GOTO KIL

           IF Y<1

               GOTO D1

           SET SDT=+Y

 +1        IF SDT'<DT

               WRITE *7,"  [Must Start before Today!] "

               GOTO D1

D2         KILL %DT

           SET %DT="AEPX"

           SET %DT("A")=" Ending Date: "

           DO ^%DT

           IF U[X!($DATA(DTOUT))

               GOTO KIL

           IF Y<1

               GOTO D2

           SET EDT=+Y

 +1        IF EDT>DT

               WRITE *7,"  [Greater than Today?] "

               GOTO D1

 +2        IF EDT'>SDT

               WRITE *7,"  [Must End after Start] "

               GOTO D1

 +3        SET X1=EDT\1

           SET X2=SDT\1

           DO ^%DTC

 +4        IF '%Y!(X<1)

               GOTO DT

 +5        SET NOM=+X+1

 +6        WRITE !!,"This Report shows the status change on the starting date and on the ending date.",!,"Excludes any Admission starting from the starting date.",!

 +7        GOTO L0

E2        ; Get # of Days from Admission

 +1        WRITE !

           KILL DIR

           SET DIR(0)="NAO^3:99"

           SET DIR("?")="The response must be a number from 3-99"

 +2        SET DIR("A")="Enter # of Days from Admission: "

 +3        DO ^DIR

           IF $DATA(DIRUT)!($DATA(DIROUT))

               GOTO KIL

           SET NOM=+Y

L0         KILL IOP,%ZIS

           SET %ZIS("A")="Print on Device: "

           SET %ZIS="MQ"

           WRITE !

           DO ^%ZIS

           KILL %ZIS,IOP

           IF POP

               GOTO KIL

 +1        IF $DATA(IO("Q"))

               SET FHPGM="Q0^FHASN4"

               SET FHLST="FHX1^NOM^SDT^EDT^WRDS"

               DO EN2^FH

               GOTO KIL

 +2        USE IO

           DO Q0^FHASN4

           DO ^%ZISC

           KILL %ZIS,IOP

           IF 'WRDS

               GOTO KIL

           GOTO FHASN3

KIL        KILL ^TMP($JOB)

           GOTO KILL^XUSCLEAN

HD        ; Check for end of page

 +1        IF IOST?1"C".E

               IF $X>1

                   WRITE !

               WRITE *7

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               IF 'Y

                   SET ANS="^"

                   QUIT 

HDR       ; Print heading

 +1        IF '($EXTRACT(IOST,1,2)'="C-"&'PG)

               WRITE @IOF

           SET PG=PG+1

           WRITE !,HD,?72,"Page ",PG

 +2        WRITE !!?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"

 +3        WRITE !!,"WARD",?30,DTE,!,$PIECE(NAM,"~",1)

 +4        IF FHX1=1

               WRITE !?17,"Shows Status Change on Start Date and End Date",!?17,"(Excludes Any Admission from the starting date)"

 +5        WRITE !!,?23,"BEG STATUS",?54,"END STATUS",?73,"STATUS"

 +6        WRITE !,"STATUS",?26,"TOTAL",?43,"I     II    III     IV    UNC   SAME",!,LN,!

           QUIT