source: FOIAVistA/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKRCH.m@ 1334

SOWKRCH ;B'HAM ISC/SAB-Routine to print RCH AMIS 256 report ; 24 Feb 93 / 2:32 PM [ 09/29/94  8:18 AM ]
 ;;3.0; Social Work ;**34,53**;27 Apr 93
 K ^TMP($J),PLP I '$D(^SOWK(650.1,1)) W *7,!,"PLEASE ENTER SITE PARAMETERS !!",! G CLOS
BEG W ! S %DT="AEXP",%DT("A")="ALL CASES STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SB1=Y X ^DD("DD") S SBA=Y
END W ! S %DT("A")="ALL CASES ENDING: " D ^%DT G:"^"[X CLOS G:Y'>0 END S SE1=Y X ^DD("DD") S SEA=Y
 D DEV I $D(ZTSK)!($D(OUT))!(POP) K ZTSK G CLOS
ENQ F SOWK=0:0 S SOWK=$O(^SOWK(650.1,SOWK)) Q:'SOWK!($G(OUT1)=1)  D START K ^TMP($J)
CLOS W:$E(IOST)'["C" @IOF D ^%ZISC
 K ^TMP($J),PL,II,HM,OUT,AB,ABB,SBB,SW,SWW,O,OUT1,P,R,SB,SB1,SE1,SWB,SWE,SWLT,SP,D,H,J,IOP,POP,SOWK,DIS,DFN,LCN,SWTHT D KVA^VADPT
 K LC,SOWKFD,SOWKFB,SOWKDIV,SWTOT,SWPTO,SWLT,SWPLT,SWVT,SWPV,%DT,AG,C,EE,F,G,I,L,M,N,S D:$D(ZTSK) KILL^%ZTLOAD
 K PCH,E,V,B,K,SWPLT,SWPLTO,SWPV,SWTOT,SWVT,T,X,X1,X2,Y,Z,ST,STT,Q,SBA,SEA,CN,RCH,SOWKAB,PLP
 Q
START F T=1:1:10 S (LP(T),LPP(T))=0
 F N=1:1:3 S (NB(N),NBB(N))=0
 F N=0:0 S N=$O(^SOWK(650.1,1,2,N)) Q:'N  S (ST(N),STT(N))=0
 S (SWTHT,SWPT,SWPU,SWPP,SWTT,SWPTT,SWTOT,SWPTO,SWLT,SWPLT,SWPLTO,SWVT,SWPV)=0
 F T=0:1:4 S (AB(T),ABB(T),SB(T),SBB(T),SW(T),SWW(T))=0
 K T S SOWKDIV=SOWK
 U IO W:$Y @IOF W ?20,"RCH AMIS 256 FROM ",SBA," TO ",SEA
 W !,"TOTAL FOR "_$P(^SOWK(650.1,SOWK,0),"^"),!!
 ;CALCULATE TOTALS
 S SOWKAB="ALL" D CAL,PRINT I $G(OUT1)'=1 D ^SOWKRCH1 I $G(OUT1)'=1 S SOWKFD=SB1,SOWKFB=SE1 D ENQ^SOWKPAOD,ENQ^SOWKDSC
 Q
CAL F II=0:0 S II=$O(^SOWK(650,II)) Q:'II  S B=^SOWK(650,II,0) I B,$P(^SOWK(651,$P(B,"^",13),0),"^",6)="R",$P(B,"^",5)=SOWK S (P,DFN)=$P(B,"^",8),LC=$P(B,"^",23) D DEM^VADPT,SEA
 Q
REM S:+LC NB(LC)=NB(LC)+1 I $P(B,"^",14) S ST($P(B,"^",14))=ST($P(B,"^",14))+1
 Q
SEA I $D(^SOWK(655,P,4)) S PL=^SOWK(655,P,0) F HM=0:0 S HM=$O(^SOWK(655,P,4,HM)) Q:'HM  I $P(^SOWK(655,P,4,HM,0),"^",5)=II S PCH=^(0),RCH=$P(^(0),"^") D SE1
 Q
SE1 S AG=+VADM(4),X=$S(AG<29:0,AG'<30&(AG'>44):1,AG'<45&(AG'>59):2,AG'<60&(AG'>79):3,1:4)
 I $P(PL,"^",2)'<SB1,$P(PL,"^",2)'>SE1,'$P(PCH,"^",6),'$O(^TMP($J,P,0)) S ^TMP($J,P,II)="" S SW(X)=SW(X)+1
 I $P(PCH,"^",4)'<SB1,$P(PCH,"^",4)'>SE1,'$P(PCH,"^",6) S SB(X)=SB(X)+1
 D REQ
 I $P(PL,"^",2)'<SB1,$P(PL,"^",2)'>SE1,'$P(PCH,"^",6) S LP($P(B,"^",11))=$G(LP($P(B,"^",11)))+1 I $O(^TMP($J,P,0)),$O(^TMP($J,P,0))'=II S CN=$O(^TMP($J,P,0)),LP($P(^SOWK(650,CN,0),"^",11))=$G(LP($P(^SOWK(650,CN,0),"^",11)))-1
 Q
REQ ;
 I $P(PCH,"^",2)'<SB1,'$P(PCH,"^",4),$P(PCH,"^",2)'>SE1 S AB(X)=$G(AB(X))+1 D REM Q
 I $P(PCH,"^",2)'<SB1,$P(PCH,"^",2)'>SE1,$P(PCH,"^",4)>SE1 S AB(X)=$G(AB(X))+1 D REM Q
 I $P(PCH,"^",2)<SB1,$P(PCH,"^",4)>SE1 S AB(X)=$G(AB(X))+1 D REM Q
 I $P(PCH,"^",2)<SB1,'$P(PCH,"^",4) S AB(X)=$G(AB(X))+1 D REM
 Q
DEV W !!,"WARNING !!!",!?5,"This report is formatted for 132 columns and will be",!?5,"difficult to read if printed to the screen.",!
 K ZTSK,%ZIS,IOP,OUT 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 ZTDESC="RESIDENTIAL CARE HOME AMIS REPORT",ZTRTN="ENQ^SOWKRCH" F G="SE1","SB1","SBA","SEA" S:$D(@G) ZTSAVE(G)=""
 I  K IO("Q") D ^%ZTLOAD I '$D(ZTSK) S OUT=1 W:$E(IOST)'["C" @IOF D ^%ZISC K %DT,SB1,SE1,G,SEA,SBA Q
 I $D(ZTSK) W !!,"Task Queued to Print",! K G,SEA,SBA,%DT,SB1,SE1
 Q
PRINT ;PRINT TOTALS
 F T=0:1:4 S SWTOT=SW(T)+SWTOT
 F T=0:1:4 S:SWTOT SWW(T)=(SW(T)/SWTOT)*100,SWPTO=SWW(T)+SWPTO
 F T=0:1:4 S SWLT=SB(T)+SWLT,SWVT=AB(T)+SWVT
 F T=0:1:4 S:SWLT SBB(T)=(SB(T)/SWLT)*100,SWPLTO=SBB(T)+SWPLTO
 F T=0:1:4 S:SWVT ABB(T)=(AB(T)/SWVT)*100,SWPV=ABB(T)+SWPV
 F X=1:1:3 D  Q:$G(OUT1)=1
 .U IO W !!?10,$S(X=1:"CASES OPENED DURING QUARTER",X=2:"CASES CLOSED DURING QUARTER",1:"TOTAL CASES TREATED")
 .W !?4,"LESS",?11,"30",?17,"45",?23,"60",?29,"80",!?4,"THAN",?11,"TO",?17,"TO",?23,"TO",?29,"AND",!?5,"29",?11,"44",?17,"59",?23,"79",?29,"UP",?35,"TOTAL",! F F=1:1:41 W "-"
 .I X=1 D
 ..W !,"NO.",?5,$J(SW(0),3,0),?11,$J(SW(1),3,0),?17,$J(SW(2),3,0),?23,$J(SW(3),3,0),?29,$J(SW(4),3,0),?35,$J(SWTOT,3,0)
 ..W !,"%",?5,$J(SWW(0),3,0),?11,$J(SWW(1),3,0),?17,$J(SWW(2),3,0),?23,$J(SWW(3),3,0),?29,$J(SWW(4),3,0),?35,$J(SWPTO,3,0),!
 .I X=2 D
 ..W !,"NO.",?5,$J(SB(0),3,0),?11,$J(SB(1),3,0),?17,$J(SB(2),3,0),?23,$J(SB(3),3,0),?29,$J(SB(4),3,0),?35,$J(SWLT,3,0)
 ..W !,"%",?5,$J(SBB(0),3,0),?11,$J(SBB(1),3,0),?17,$J(SBB(2),3,0),?23,$J(SBB(3),3,0),?29,$J(SBB(4),3,0),?35,$J(SWPLTO,3,0),!
 .I X=3 D
 ..W !,"NO.",?5,$J(AB(0),3,0),?11,$J(AB(1),3,0),?17,$J(AB(2),3,0),?23,$J(AB(3),3,0),?29,$J(AB(4),3,0),?35,$J(SWVT,3,0)
 ..W !,"%",?5,$J(ABB(0),3,0),?11,$J(ABB(1),3,0),?17,$J(ABB(2),3,0),?23,$J(ABB(3),3,0),?29,$J(ABB(4),3,0),?35,$J(SWPV,3,0),!
 .F F=1:1:41 W "-"
 .D:($Y+10)>IOSL CHK
 W !!!
 Q
CHK ;
 N SWXX
 I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT1=1 W @IOF Q
 W @IOF
 Q