| 1 | FHADRPT ; HISC/NCA - Print Dietetic Annual Report ;1/23/98 16:05
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | EN1 ; Get the Station Data for Printing
|
|---|
| 4 | D GET^FHADR1 G:Y<1 KIL
|
|---|
| 5 | S FHX1=+Y,LS=$E(DT,1,3) W !
|
|---|
| 6 | Q0 K %DT S PRE="",FG=0,%DT="AEP",%DT("A")="Enter YR: "
|
|---|
| 7 | D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,Q0:Y<1
|
|---|
| 8 | I $E(Y,1,3)>LS W *7," Do Not Enter Future Year." G Q0
|
|---|
| 9 | I $E(Y,4,7)>0 W *7," Enter Year Only." G Q0
|
|---|
| 10 | S Y=$E(Y,1,3)_"0000",PRE=Y,FG=1
|
|---|
| 11 | S QTR=$E(PRE,5),YR=$E(PRE,2,3)
|
|---|
| 12 | L0 K IOP,%ZIS,ZTUCI,ZTRTN,ZTSAVE,ZTDESC
|
|---|
| 13 | W !!,"The report requires a 132 column printer.",!
|
|---|
| 14 | S %ZIS="QM",%ZIS("B")="",IOP="Q" W !! D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 15 | I $D(IO("Q")) D G KIL
|
|---|
| 16 | .S ZTRTN="TSK^FHADRPT",ZTREQ="@",ZTSAVE("ZTREQ")=""
|
|---|
| 17 | .S ZTSAVE("FG")="",ZTSAVE("FHX1")="",ZTSAVE("PRE")=""
|
|---|
| 18 | .S ZTSAVE("QTR")="",ZTSAVE("YR")=""
|
|---|
| 19 | .S ZTDESC="Print the Dietetic Annual Report"
|
|---|
| 20 | .D ^%ZTLOAD
|
|---|
| 21 | .Q
|
|---|
| 22 | E D G L0
|
|---|
| 23 | .D ^%ZISC
|
|---|
| 24 | .W !?5,"This is a very long and time consuming"
|
|---|
| 25 | .W !?5,"report, it must be queued to print.",*7
|
|---|
| 26 | .Q
|
|---|
| 27 | G KIL
|
|---|
| 28 | TSK ; Tasking the Report
|
|---|
| 29 | U IO D Q1 D ^%ZISC K %ZIS,IOP,ZTSK G KIL
|
|---|
| 30 | Q1 ; Display the Report
|
|---|
| 31 | S PG=0,LIN=IOSL-6
|
|---|
| 32 | S FHYR=$E(PRE,1,3) D NOW^%DTC S DTP=% D DTP^FH S HEAD=DTP
|
|---|
| 33 | D EN2^FHADR1A,EN2^FHADR3A,EN2^FHADR2,Q1^FHADR4,Q0^FHADR5,EN2^FHADR6
|
|---|
| 34 | D EN2^FHADR61,EN2^FHADR7,EN2^FHADR81,EN2^FHADR9A,EN2^FHADR10
|
|---|
| 35 | Q
|
|---|
| 36 | Q2 ; Find the Starting Month and Ending Month of Each Quarter
|
|---|
| 37 | S (EDT,MTH,SDT)=""
|
|---|
| 38 | S MTH=$P("October^January January^April April^July July^October"," ",QTR)
|
|---|
| 39 | I MTH="" W *7," Error! Wrong Qtr" Q
|
|---|
| 40 | L1 K %DT S X=$P(MTH,"^",1)_" "_(1700+$E(FHYR,1,3)) D ^%DT I QTR=1 S X1=+Y,X2=-365 D C^%DTC S X=$E(X,1,6)_"1" S SDT=+X G L2
|
|---|
| 41 | S SDT=Y+1
|
|---|
| 42 | L2 I SDT>DT S SDT="" Q
|
|---|
| 43 | S X=$P(MTH,"^",2)_" "_(1700+$E(FHYR,1,3)) D ^%DT S X1=Y,X2=-1 D C^%DTC S EDT=X
|
|---|
| 44 | I EDT>DT S EDT="" Q
|
|---|
| 45 | S SDT=SDT\1,EDT=EDT\1
|
|---|
| 46 | Q
|
|---|
| 47 | HDR ; Report Header
|
|---|
| 48 | W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1
|
|---|
| 49 | W !?13,HEAD,?50,"D I E T E T I C R E P O R T",?116,"Page ",PG
|
|---|
| 50 | W !!?105 S Q1=$S(FG:"1 - 4",1:"") W Q1," Qtr FY ",$E(FHYR,2,3) Q
|
|---|
| 51 | KIL G KILL^XUSCLEAN
|
|---|
