source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKPAOD.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1SOWKPAOD ;B'HAM ISC/SAB-Routine to print Divisional Problems & Outcome report ; 25 Feb 93 / 9:19 AM [ 09/23/94 9:55 AM ]
2 ;;3.0; Social Work ;**34,53**;27 Apr 93
3 Q:'$D(SOWK) S SOWKFD=""
4BEG W ! S %DT="AEXP",%DT("A")="ALL CASES STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SOWKFD=Y
5EN W ! S %DT("A")="ALL CASES ENDING: " D ^%DT G:"^"[X CLOS G:Y'>0 EN S SOWKFB=Y
6DEV W !!,"WARNING !!!",!?5,"This report is formatted for 132 columns and will be",!?5,"difficult to read if printed to the screen.",!
7 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
8 K SOWKION I $D(IO("Q")) S ZTDESC="DIVISONAL PROBLEMS AND OUTCOME REPORT",ZTRTN="ENQ^SOWKPAOD" F G="SOWKAB","SOWKDIV","SOWK","SOWKFD","SOWKFB" S ZTSAVE(G)=""
9 I K IO("Q") D ^%ZTLOAD I '$D(ZTSK) K G,%DT,X,ZTSAVE Q
10 I $D(ZTSK) K G,%DT,X,ZTSK W !!,"Task Queued to Print",! Q
11ENQ S (TOT,VT,HT,TOTB)=0
12 F I=0:0 S I=$O(^SOWK(655.203,I)) Q:'I S (TO(I),IM(I))=0 F P=0:0 S P=$O(^SOWK(655.201,P)) Q:'P S:$P(^SOWK(655.201,P,0),"^",2) (SW(P,I),PT(P),VT(P))=0
13 S SWD=SOWKFD-1 F I=0:0 S SWD=$O(^SOWK(650,"ACD",SWD)) Q:SWD>SOWKFB!'SWD F B=0:0 S B=$O(^SOWK(650,"ACD",SWD,B)) Q:'B S A=^SOWK(650,B,0) I $P(A,"^",5)=SOWK D CAT
14 ;CALCULATES AND PRINTS TOTALS
15 F I=0:0 S I=$O(^SOWK(655.203,I)) Q:'I F P=0:0 S P=$O(^SOWK(655.201,P)) Q:'P S:$D(SW(P,I)) TO(I)=SW(P,I)+TO(I)
16 F P=0:0 S P=$O(^SOWK(655.201,P)) Q:'P F I=0:0 S I=$O(^SOWK(655.203,I)) Q:'I S:$D(SW(P,I)) VT(P)=SW(P,I)+VT(P)
17 F I=0:0 S I=$O(^SOWK(655.203,I)) Q:'I S VT=TO(I)+VT
18 F I=0:0 S I=$O(^SOWK(655.201,I)) Q:'I I $D(VT(I)),$D(PT(I)) S:VT PT(I)=(VT(I)/VT)*100,HT=PT(I)+HT
19 F I=0:0 S I=$O(^SOWK(655.203,I)) Q:'I S:VT IM(I)=(TO(I)/VT)*100,TOT=IM(I)+TOT
20 S:TOT TOTB=(TOT/TOT)*100
21 U IO W:$Y @IOF W "COMPLETE SERVICE for DIVISION "_$P(^SOWK(650.1,SOWKDIV,0),"^"),!
22 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),?45,"Problems and Outcomes Report",!!
23 W ?8,"CLINICAL",?22,"PLANNED",?32,"PARTIALLY",?45,"PARTIALLY",?58,"PARTIALLY"
24 W !?8,"DECISION",?22,"RESULTS",?32,"ATTAINED",?45,"ATTAINED",?58,"ATTAINED",?72,"NOT ATTAINED",?87,"NOT ATTAINED",?102,"NOT ATTAINED"
25 W !,"PROB.",?8,"NOT TO TREAT",?22,"ATTAINED",?32,"P/F BARR.",?45,"CR BARR.",?58,"VAMC BARR.",?72,"P/F BARR.",?87,"CR BARR.",?102,"VAMC BARR.",?120,"TOTALS",?130,"%"
26 F I=0:0 S I=$O(^SOWK(655.201,I)) Q:'I!($G(OUT1)=1) D PRI
27 G:$G(OUT1)=1 CLOS
28 W !,"TOTALS",?10,$J(TO(1),3,0),?22,$J(TO(2),3,0),?32,$J(TO(3),3,0),?45,$J(TO(4),3,0),?58,$J(TO(5),3,0),?72,$J(TO(6),3,0),?87,$J(TO(7),3,0),?102,$J(TO(8),3,0),?120,$J(VT,3,0),?128,$J(HT,3,0)
29 W !,"PERCENT",?10,$J(IM(1),3,0),?22,$J(IM(2),3,0),?32,$J(IM(3),3,0),?45,$J(IM(4),3,0),?58,$J(IM(5),3,0),?72,$J(IM(6),3,0),?87,$J(IM(7),3,0),?102,$J(IM(8),3,0),?120,$J(TOT,3,0),?128,$J(TOTB,3,0)
30 W !!?10,"NOTE: P/F=PATIENT/FAMILY, CR=COMMUNITY RESOURCES, BARR.=BARRIERS"
31CLOS I $G(SOWKAB)'="ALL" W:$E(IOST)'["C" @IOF D ^%ZISC K SOWKAB,SOWKFB,SOWKFD,Y
32 K I,P,SW,SWD,B,A,%DT,HT,K,Q,TOT,TOTB,VT,C,T,TO,IM,PT,OUT1,VT,C,DIC,IOP,POP D:$D(ZTSK) KILL^%ZTLOAD
33 Q
34CAT F P=0:0 S P=$O(^SOWK(650,B,2,P)) Q:'P S C=$P(^(P,0),"^"),T=$P(^(0),"^",2) F Q=0:0 S Q=$O(^SOWK(655.201,Q)) Q:'Q F K=0:0 S K=$O(^SOWK(655.203,K)) Q:'K I Q=C,K=T S SW(Q,K)=SW(Q,K)+1
35 Q
36PRI D:$E(IOST)["C"&($O(^SOWK(655.201,0))'=I) CHK Q:$G(OUT1)=1 I $D(SW(I,1)) W !,$J($P(^SOWK(655.201,I,0),"^",2),2,0)
37 W ?10,$J(SW(I,1),3,0),?22,$J(SW(I,2),3,0),?32,$J(SW(I,3),3,0),?45,$J(SW(I,4),3,0),?58,$J(SW(I,5),3,0),?72,$J(SW(I,6),3,0),?87,$J(SW(I,7),3,0),?102,$J(SW(I,8),3,0),?120,$J(VT(I),3,0),?128,$J(PT(I),3,0)
38 Q
39CHK ;
40 Q:($Y+5)'>IOSL
41 N SWXX
42 I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT1=1
43 W @IOF
44 Q
Note: See TracBrowser for help on using the repository browser.