62 lines
3.5 KiB
Mathematica
62 lines
3.5 KiB
Mathematica
|
SOWKLC ;B'HAM ISC/SAB,DLR-LOCATION OF PATIENTS BY COST CENTERS REPORT ; 02 Mar 94 / 9:50 AM [ 08/05/94 7:58 AM ]
|
||
|
|
;;3.0; Social Work ;**17,25,30,31,35,53**;27 Apr 93
|
||
|
|
S:$G(SOWKAB)'="ALL" SOWKFD="" G:SOWKFD]"" ENQ
|
||
|
|
BEG W ! S %DT="AEXP",%DT("A")="ALL CASES STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SOWKFD=Y
|
||
|
|
EN S %DT("A")="ALL CASES ENDING: " D ^%DT G:"^"[X CLOS G:Y'>0 EN S SOWKFB=Y
|
||
|
|
F L=0:0 W !,"Do you want Complete Service " S %=2 D YN^DICN Q:% I %Y["?" D YN^SOWKHELP
|
||
|
|
I %=1 S SWA=1,SWB=0 G ACU
|
||
|
|
G:%=-1 CLOS F L=0:0 W !,"Do you want report by Supervisor " S %=2 D YN^DICN Q:% I %Y["?" D YN^SOWKHELP
|
||
|
|
I %=1 S SWB=1,SWA=0
|
||
|
|
G:%=2 SWW G:%=-1 CLOS S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter Supervisor's last name: ",D="B",DIC("S")="I $D(^VA(200,""ASWC"",+Y))"
|
||
|
|
D IX^DIC G:"^"[X CLOS S SWZ=+Y K DIC G:Y'>0 CLOS G ACD
|
||
|
|
SWW S DIC("S")="I $D(^VA(200,+Y,654)),$P(^VA(200,+Y,654),""^"")",DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter Social Worker's last name: "
|
||
|
|
D ^DIC G:"^"[X CLOS S SWZ=+Y K DIC G:Y'>0 CLOS S (SWA,SWB)=0 G ACB
|
||
|
|
ACU ;CALCULATE TOTALS
|
||
|
|
D DEV I $D(ZTSK)!($D(OUT))!(POP) K ZTSK G CLOS
|
||
|
|
ENQ Q:"^"[X
|
||
|
|
EN1 G:SWB ENQ1 G:'SWA&'SWB ENQ2 S SWLP=0
|
||
|
|
EN2 S SWLP=0 F I=0:0 S I=$O(^SOWK(650,I)) Q:'I S AA=^SOWK(650,I,0) D SAB
|
||
|
|
CU ;PRINT TOTALS
|
||
|
|
I SWLP=0 G NR
|
||
|
|
W:$Y @IOF D HDR
|
||
|
|
F T=0:0 S T=$O(^SOWK(651,T)) Q:'T!($G(OUT1)=1) I $D(SW(T)),'$P(^SOWK(651,T,0),"^",2) S SWL=$P(^(0),"^") D CHK Q:$G(OUT1)=1 D
|
||
|
|
.W !,SWL_" ("_$P(^(0),"^",4)_")",?57,$J($S('$D(SW(T)):0,1:SW(T)),3,0),?63,$J($S('$D(SW(T)):0,1:SW(T))/SWLP*100,3,0)
|
||
|
|
D CHK Q:$G(OUT1)=1 W !!,"TOTAL",?57,$J(SWLP,3,0),?63,$S(SWLP:$J("100",3,0),1:$J(SWLP,3,0)),!
|
||
|
|
CLOS I $E(IOST)["C",('$G(OUT1)) R !,"Press <RETURN> to continue: ",SWXX:DTIME K SWXX W @IOF
|
||
|
|
I $G(SOWKAB)'="ALL" W:$E(IOST)'["C" @IOF D ^%ZISC K A,Z,B,SOWKFB,SOWKFD,SOWKAB,SWA,SWB,SWZ,OUT1
|
||
|
|
K X,L,D,AA,%,%Y,SWLP,SWAL,SWD,%DT,I,T,SW,SWL,SWLB,IOP,POP,%ZIS,DIC,Y D:$D(ZTSK) KILL^%ZTLOAD
|
||
|
|
Q
|
||
|
|
ACD D DEV I $D(ZTSK)!($D(OUT))!(POP) K ZTSK G CLOS
|
||
|
|
ENQ1 ;
|
||
|
|
S SWLP=0
|
||
|
|
F I=0:0 S I=$O(^SOWK(650,I)) Q:'I S AA=^SOWK(650,I,0) I $P(^VA(200,$P(AA,"^",3),654),"^",2)=SWZ D SAB
|
||
|
|
G CU
|
||
|
|
Q
|
||
|
|
ACB D DEV I $D(ZTSK)!($D(OUT))!(POP) K ZTSK G CLOS
|
||
|
|
ENQ2 ;
|
||
|
|
S SWLP=0 F I=0:0 S I=$O(^SOWK(650,I)) Q:'I S AA=^SOWK(650,I,0) I $P(AA,"^",3)=SWZ D SAB
|
||
|
|
G CU
|
||
|
|
Q
|
||
|
|
NR I SWA,'SWB U IO W *7,!,"THERE IS NOTHING TO REPORT FOR LOCATION OF PATIENTS BY COST CENTERS ",! G CLOS
|
||
|
|
U IO W *7,!,"THERE IS NOTHING TO REPORT ON AMIS LOCATIONS FOR ",$P(^VA(200,SWZ,0),"^"),! G CLOS
|
||
|
|
SAB I $P(AA,"^",2)'>SOWKFB,$P(AA,"^",13),('$P(AA,"^",18)!($P(AA,"^",18)&($P(AA,"^",18)'<SOWKFD))) S SWAL=$P(AA,"^",13),SW(SWAL)=$S('$D(SW(SWAL)):0,1:SW(SWAL))+1,SWLP=SWLP+1
|
||
|
|
Q
|
||
|
|
DEV ;
|
||
|
|
S OUT1=0
|
||
|
|
K ZTSK,OUT,%ZIS,IOP,POP S SOWKION=ION,%ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K IOP,SOWKION S POP=1 Q
|
||
|
|
K SOWKION I $D(IO("Q")) S ZTRTN=$S(SWA:"EN1^SOWKLC",SWB:"ENQ1^SOWKLC",'SWA&'SWB:"ENQ2^SOWKLC",1:"EN1^SOWKLC") F G="SOWKAB","SOWKFD","SOWKFB","SWZ","SWB","SWA","X","OUT1" S ZTSAVE(G)=""
|
||
|
|
I K IO("Q") D ^%ZTLOAD K DIC,G,%DT,X I '$D(ZTSK) S OUT=1 W:$E(IOST)'["C" @IOF D ^%ZISC Q
|
||
|
|
I $D(ZTSK) K G,%DT,DIC,X W !!,"Task Queued to Print",!
|
||
|
|
Q
|
||
|
|
HDR Q:$G(OUT1)=1
|
||
|
|
U IO W $S(SWA:"COMPLETE SERVICE",SWB:"SUPERVISOR "_$P(^VA(200,SWZ,0),"^"),1:"SOCIAL WORKER "_$P(^VA(200,SWZ,0),"^"))
|
||
|
|
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),?25,"LOCATION OF PATIENTS BY COST CENTERS",!
|
||
|
|
W ?57,"NO.",?65,"%",!!
|
||
|
|
Q
|
||
|
|
CHK ;checks for end of page
|
||
|
|
Q:($Y+8)'>IOSL
|
||
|
|
N SWXX
|
||
|
|
I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX="^" S OUT1=1 W @IOF Q
|
||
|
|
W @IOF D HDR
|
||
|
|
Q
|