| 1 | SOWKRFD ;B'HAM ISC/SAB-Routine to print Divisional Referral report ; 01 Feb 94 / 1:49 PM [ 08/05/94 8:01 AM ]
|
|---|
| 2 | ;;3.0; Social Work ;**17,31,35,53**;27 Apr 93
|
|---|
| 3 | Q:'$D(SOWK)
|
|---|
| 4 | S:$G(SOWKAB)'="ALL" SOWKFD=""
|
|---|
| 5 | G:SOWKFD]"" ENQ
|
|---|
| 6 | BEG I SOWKFD="" W ! S %DT="AEXP",%DT("A")="ALL CASES STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SOWKFD=Y
|
|---|
| 7 | EN S %DT("A")="ALL CASES ENDING: " D ^%DT G:"^"[X CLOS G:Y'>0 EN S SOWKFB=Y
|
|---|
| 8 | DEV ;
|
|---|
| 9 | K ZTSK,OUT,%ZIS,IOP S SOWKION=ION,%ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K IOP,SOWKION G CLOS
|
|---|
| 10 | K SOWKION I $D(IO("Q")) S ZTDESC="SOCIAL WORK DIVISIONAL RESOURCES/REFERRALS REPORT",ZTRTN="ENQ^SOWKRFD" F G="SOWK","SOWKDIV","SOWKAB","SOWKFD","SOWKFB" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 11 | I K IO("Q") D ^%ZTLOAD I '$D(ZTSK) K G,%DT G CLOS Q
|
|---|
| 12 | I $D(ZTSK) K G,%DT,ZTSK W !!,"Task Queued to Print",! G CLOS Q
|
|---|
| 13 | ENQ ;CALCULATES TOTAL
|
|---|
| 14 | S OUT=0
|
|---|
| 15 | D CLE F I=0:0 S I=$O(^SOWK(650,I)) Q:'I S H=^SOWK(650,I,0) F C=0:0 S C=$O(^SOWK(650,I,1,C)) Q:'C I $P(H,"^",18)'<SOWKFD,$P(H,"^",5)=SOWKDIV,$P(H,"^",18)'>SOWKFB S W=$P(^SOWK(650,I,1,C,0),"^") D RES
|
|---|
| 16 | ;PRINT TOTALS
|
|---|
| 17 | S:US PT=(US/US)*100 S:NU NPT=(NU/NU)*100
|
|---|
| 18 | F O=0:0 S O=$O(^SOWK(653,O)) Q:'O S:US TP(O)=(US(O)/US)*100 S:NU NA(O)=(NU(O)/NU)*100
|
|---|
| 19 | W:$Y @IOF D HDR
|
|---|
| 20 | F I=0:0 S I=$O(^SOWK(653,I)) Q:'I!(OUT) D:($Y+5)>IOSL FF Q:OUT W !,$E($P(^SOWK(653,I,0),"^"),1,24),?25,$J(US(I),3,0),?36,$J(TP(I),3,0),?43,$J(NU(I),3,0),?54,$J(NA(I),3,0)
|
|---|
| 21 | W:'OUT !,"TOTALS",?25,$J(US,3,0),?36,$J(PT,3,0),?43,$J(NU,3,0),?54,$J(NPT,3,0),!
|
|---|
| 22 | CLOS I $E(IOST)["C",('$G(OUT)) R !,"Press <RETURN> to continue: ",SWXX:DTIME K SWXX W @IOF
|
|---|
| 23 | W ! I $G(SOWKAB)'="ALL" W:$E(IOST)'["C" @IOF D ^%ZISC K SOWKAB,SOWKFD,SOWKFB
|
|---|
| 24 | K X,NA,US,NU,H,NPT,PT,O,C,Y,US,TP,Q,POP,%DT,A,SWD,G,I,W D:$D(ZTSK) KILL^%ZTLOAD
|
|---|
| 25 | Q
|
|---|
| 26 | CLE S (PT,NPT,US,NU)=0
|
|---|
| 27 | F I=0:0 S I=$O(^SOWK(653,I)) Q:'I S (NA(I),TP(I),US(I),NU(I))=0
|
|---|
| 28 | Q
|
|---|
| 29 | RES I $P(^SOWK(650,I,1,C,0),"^",3) S US(W)=US(W)+1,US=US+1 Q
|
|---|
| 30 | S NU(W)=NU(W)+1,NU=NU+1
|
|---|
| 31 | Q
|
|---|
| 32 | HDR U IO W "COMPLETE SERVICE for DIVISION "_$P(^SOWK(650.1,SOWKDIV,0),"^"),!
|
|---|
| 33 | W !,$E(SOWKFD,4,5)_"/"_$E(SOWKFD,6,7)_"/"_$E(SOWKFD,2,3)_" TO "_$E(SOWKFB,4,5)_"/"_$E(SOWKFB,6,7)_"/"_$E(SOWKFB,2,3),?30,"RESOURCES/REFERRALS",!!,?43,"UNABLE",!?45,"TO"
|
|---|
| 34 | W !?25,"USED",?34,"PERCENT",?43,"ACCESS",?52,"PERCENT"
|
|---|
| 35 | Q
|
|---|
| 36 | FF ;check form length for 80 column screen printed reports
|
|---|
| 37 | N SWXX
|
|---|
| 38 | I $E(IOST)["C" R !!,"Press <RETURN> to continue or ""^"" to Quit",SWXX:DTIME I SWXX["^" S OUT=1 W @IOF Q
|
|---|
| 39 | W @IOF D HDR
|
|---|
| 40 | Q
|
|---|
