- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHASN7 1244 printed Mar 13, 2025@20:51:46 Page 2
- 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
