FHASN7.m

FHASN7 ; HISC/NCA - Print Status Average ;3/10/95  08:55

 ;;5.5;DIETETICS;;Jan 28, 2005

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

 S SRT=$E(X,1)

DT ; Get From/To Dates

D1 S %DT="AEPX",%DT("A")="Starting Date: " W ! D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,D1:Y<1 S SDT=+Y

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

D2 S %DT="AEPX",%DT("A")=" Ending Date: " D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,D2:Y<1 S EDT=+Y

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

 I EDT<SDT W *7,"  [End before Start?] " G D1

L0 K IOP,%ZIS,ZTRTN,ZTSAVE,ZTDESC

 W !!,"The report requires a 132 column printer.",!

 S %ZIS="QM",%ZIS("B")="",IOP="Q" W !! D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) D  G KIL

 .K IO("Q")

 .S ZTRTN="TSK^FHASN7",ZTREQ="@"

 .S ZTSAVE("SRT")="",ZTSAVE("SDT")="",ZTSAVE("EDT")="",ZTSAVE("ZTREQ")=""

 .S ZTDESC="Nutrition Status Average"

 .D ^%ZTLOAD

 .Q

 E  D  G L0

 .D ^%ZISC

 .W !?5,"This is a very time consuming report,"

 .W !?5,"it must be queued to print.",*7

 .Q

 G KIL

TSK ; Tasking the Report

 U IO D Q0^FHASN71 D ^%ZISC K %ZIS,IOP,ZTSK G KIL

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

FHASN7    ; HISC/NCA - Print Status Average ;3/10/95  08:55

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

F0         READ !!,"Print by CLINICIAN or WARD? WARD// ",X:DTIME

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

               GOTO KIL

           IF X=""

               SET X="W"

           DO TR^FH

           IF $PIECE("CLINICIAN",X,1)'=""

               IF $PIECE("WARD",X,1)'=""

                   WRITE *7,"  Answer with C or W"

                   GOTO F0

 +1        SET SRT=$EXTRACT(X,1)

DT        ; Get From/To Dates

D1         SET %DT="AEPX"

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

           WRITE !

           DO ^%DT

           IF $DATA(DTOUT)

               SET X="^"

           IF U[X

               GOTO KIL

           IF Y<1

               GOTO D1

           SET SDT=+Y

 +1        IF SDT'<DT

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

               GOTO D1

D2         SET %DT="AEPX"

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

           DO ^%DT

           IF $DATA(DTOUT)

               SET X="^"

           IF U[X

               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,"  [End before Start?] "

               GOTO D1

L0         KILL IOP,%ZIS,ZTRTN,ZTSAVE,ZTDESC

 +1        WRITE !!,"The report requires a 132 column printer.",!

 +2        SET %ZIS="QM"

           SET %ZIS("B")=""

           SET IOP="Q"

           WRITE !!

           DO ^%ZIS

           KILL %ZIS,IOP

           IF POP

               GOTO KIL

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

               Begin DoDot:1

 +4                KILL IO("Q")

 +5                SET ZTRTN="TSK^FHASN7"

                   SET ZTREQ="@"

 +6                SET ZTSAVE("SRT")=""

                   SET ZTSAVE("SDT")=""

                   SET ZTSAVE("EDT")=""

                   SET ZTSAVE("ZTREQ")=""

 +7                SET ZTDESC="Nutrition Status Average"

 +8                DO ^%ZTLOAD

 +9                QUIT 

               End DoDot:1

               GOTO KIL

 +10      IF '$TEST

               Begin DoDot:1

 +11               DO ^%ZISC

 +12               WRITE !?5,"This is a very time consuming report,"

 +13               WRITE !?5,"it must be queued to print.",*7

 +14               QUIT 

               End DoDot:1

               GOTO L0

 +15       GOTO KIL

TSK       ; Tasking the Report

 +1        USE IO

           DO Q0^FHASN71

           DO ^%ZISC

           KILL %ZIS,IOP,ZTSK

           GOTO KIL

KIL        KILL ^TMP($JOB)

           GOTO KILL^XUSCLEAN