[613] | 1 | SOWKDSC ;B'HAM ISC/SAB-DIRECT SERVICES CATEGORY REPORT ; [ 08/20/96 7:32 AM ]
|
---|
| 2 | ;;3.0; Social Work ;**17,34,43,53**;27 Apr 93
|
---|
| 3 | BEG W ! S %DT="AEXP",%DT("A")="DIRECT SERVICES PROVIDED FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SB1=Y
|
---|
| 4 | EN S %DT("A")="ENDING: " D ^%DT G:"^"[X CLOS G:Y'>0 EN S SE1=Y
|
---|
| 5 | I '$D(SOWK) D ASK
|
---|
| 6 | G:$G(SOWOUT)=1 CLOS
|
---|
| 7 | DEV ;
|
---|
| 8 | K ZTSK,%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
|
---|
| 9 | S:'$D(SOWKAB) SOWKAB="" K SOWKION I $D(IO("Q")) S ZTDESC="DIRECT SERVICES REPORT",ZTRTN="ENQ^SOWKDSC" F G="SB1","SE1","SOWKAB","SOWK","SOWKDIV","SWA","SWB","SWZ" S:$D(@G) ZTSAVE(G)=""
|
---|
| 10 | I K IO("Q") D ^%ZTLOAD I '$D(ZTSK) K G,%DT G CLOS
|
---|
| 11 | I $D(ZTSK) K G,%DT,ZTSK W !!,"Task Queued to Print",! G CLOS
|
---|
| 12 | ENQ ;queue report entry point
|
---|
| 13 | S SOWOUT=0
|
---|
| 14 | D CLE
|
---|
| 15 | I $D(SOWK) D DV
|
---|
| 16 | I '$D(SOWK) D CS
|
---|
| 17 | F I=0:0 S I=$O(^SOWK(655.202,I)) Q:'I S:TOT TP(I)=(DSC(I)/TOT)*100
|
---|
| 18 | U IO W:$Y @IOF W ?5,"DIRECT SERVICES CATEGORY FOR "_$S($D(SOWK):"DIVISION "_$P(^SOWK(650.1,SOWKDIV,0),"^"),$G(SWA)=1!('$D(SWA)):"COMPLETE SERVICE",$G(SWB)=1:"SUPERVISOR: "_$P(^VA(200,SWZ,0),"^"),1:"SOCIAL WORKER: "_$P(^VA(200,SWZ,0),"^"))
|
---|
| 19 | W !!,$E($S($D(SB1):SB1,1:SOWKFD),4,5)_"/"_$E($S($D(SB1):SB1,1:SOWKFD),6,7)_"/"_$E($S($D(SB1):SB1,1:SOWKFD),2,3)_" TO "_$E($S($D(SE1):SE1,1:SOWKFB),4,5)_"/"_$E($S($D(SE1):SE1,1:SOWKFB),6,7)_"/"_$E($S($D(SE1):SE1,1:SOWKFB),2,3)
|
---|
| 20 | W !!,?60,"NUMBER",?70,"PERCENT"
|
---|
| 21 | F I=0:0 S I=$O(^SOWK(655.202,I)) Q:'I!($G(OUT)=1) D CHK Q:$G(OUT)=1 W !,$E($P(^SOWK(655.202,I,0),"^"),1,55),?60,$J(DSC(I),3,0),?70,$J(TP(I),3,0)
|
---|
| 22 | G:$G(OUT)=1 CLOS W !,"TOTALS",?60,$J(TOT,3,0),?70,$S(TOT:$J(TOT/TOT*100,3,0),1:$J(0,3,0))
|
---|
| 23 | CLOS W ! I $G(SOWKAB)'="ALL" W:$E(IOST)'["C" @IOF D ^%ZISC K X,SOWOUT,POP,IOP,OUT,SB1,SE1,Y,SOWKAB,SOWKFB,SOWKFD
|
---|
| 24 | K %DT,II,CR,I,TOT,TP,DSC D:$D(ZTSK) KILL^%ZTLOAD
|
---|
| 25 | I $E(IOST)["C" R !,"Press <RETURN> to continue: ",X:DTIME W @IOF
|
---|
| 26 | Q
|
---|
| 27 | CLE S TOT=0 F I=0:0 S I=$O(^SOWK(655.202,I)) Q:'I S (DSC(I),TP(I))=0
|
---|
| 28 | K I
|
---|
| 29 | Q
|
---|
| 30 | ;SPECIAL POPULATION ROUTINE SECTION
|
---|
| 31 | DSC F II=0:0 S II=$O(^SOWK(650,I,5,II)) Q:'II S DSC($P(^SOWK(650,I,5,II,0),"^"))=DSC($P(^SOWK(650,I,5,II,0),"^"))+1,TOT=TOT+1
|
---|
| 32 | Q
|
---|
| 33 | DV F I=0:0 S I=$O(^SOWK(650,I)) Q:'I S CR=^SOWK(650,I,0) D
|
---|
| 34 | .S W=$P(CR,U,3) I $D(SWB) Q:$S(SWB:$P(^VA(200,W,654),U,2)'=SWZ,(('SWA)&('SWB)):W'=SWZ,1:1)
|
---|
| 35 | .I $P(CR,"^",2)'<$S($D(SB1):SB1,1:SOWKFD),$P(CR,"^",2)'>$S($D(SE1):SE1,1:SOWKFB),$P(CR,"^",5)=SOWK D DSC
|
---|
| 36 | .I $P(CR,"^",2)<$S($D(SB1):SB1,1:SOWKFD),$P(CR,"^",18)'<$S($D(SB1):SB1,1:SOWKFD),$P(CR,"^",18)'>$S($D(SE1):SE1,1:SOWKFB),$P(CR,"^",5)=SOWK D DSC
|
---|
| 37 | Q
|
---|
| 38 | CS F I=0:0 S I=$O(^SOWK(650,I)) Q:'I S CR=^SOWK(650,I,0) D
|
---|
| 39 | .S W=$P(CR,U,3) I $D(SWB),($G(SWA)'=1) Q:$S(SWB:$P(^VA(200,W,654),U,2)'=SWZ,(('SWA)&('SWB)):W'=SWZ,1:1)
|
---|
| 40 | .I $P(CR,"^",2)'<$S($D(SB1):SB1,1:SOWKFD),$P(CR,"^",2)'>$S($D(SE1):SE1,1:SOWKFB) D DSC
|
---|
| 41 | .I $P(CR,"^",2)<$S($D(SB1):SB1,1:SOWKFD),$P(CR,"^",18)'<$S($D(SB1):SB1,1:SOWKFD),$P(CR,"^",18)'>$S($D(SE1):SE1,1:SOWKFB) D DSC
|
---|
| 42 | Q
|
---|
| 43 | CHK ;checks for the end of page
|
---|
| 44 | I ($Y+5)>IOSL D
|
---|
| 45 | .I $E(IOST)["C" R !,"Press <RETURN> to continue: ",X:DTIME S:X["^" OUT=1
|
---|
| 46 | .W @IOF
|
---|
| 47 | Q
|
---|
| 48 | ASK ;print screen
|
---|
| 49 | K DIR,DA S DIR(0)="YO",DIR("A")="Do you want Complete Service",DIR("?")="Enter 'YES' to print the complete service.",DIR("B")="No" D ^DIR S:$D(DUOUT) SOWOUT=1 I +Y=1 S SWA=1,SWB=0 Q
|
---|
| 50 | Q:$G(SOWOUT)=1
|
---|
| 51 | K DIR,DA S DIR(0)="YO",DIR("A")="Do you want report by Supervisor ",DIR("?")="Enter 'YES' to print the report by supervisor",DIR("B")="No" D ^DIR S:$D(DUOUT) SOWOUT=1 I +Y=1 D I +Y>0 S SWZ=+Y,SWB=1,SWA=0 Q
|
---|
| 52 | .K DIR,DA S DIR(0)="P^200:EMZ",DIR("A")="Enter Supervisor's last name ",DIR("?")="To print the report for a supervisor, enter the supervisor's last name.",DIR("S")="I $D(^VA(200,""ASWC"",+Y))" D ^DIR
|
---|
| 53 | Q:$G(SOWOUT)=1
|
---|
| 54 | K DIR,DA S DIR(0)="P^200:EMZ",DIR("A")="Enter Social Worker's last name ",DIR("?")="To print the report for a worker, enter the worker's last name.",DIR("S")="I $D(^VA(200,+Y,654)),$P(^VA(200,+Y,654),U)" D ^DIR I +Y>0 S SWZ=+Y,(SWA,SWB)=0 Q
|
---|
| 55 | S SOWOUT=1
|
---|
| 56 | Q
|
---|