source: FOIAVistA/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKPAO.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1SOWKPAO ;B'HAM ISC/SAB,DLR-Routine to print Problems & Outcome report ; 25 Feb 93 / 9:19 AM [ 09/26/94 3:23 PM ]
2 ;;3.0; Social Work ;**34,53**;27 Apr 93
3 S:'$D(SOWKAB) 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
6OC F L=0:0 W !,"Do you want Complete Service " S %=2 D YN^DICN Q:% I %Y["?" D YN^SOWKHELP
7 I %=1 S SWA=1,SWB=0 G DEV
8 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
9 I %=1 S SWB=1,SWA=0
10 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))"
11 D IX^DIC G:"^"[X CLOS S SWZ=+Y K DIC G:Y'>0 CLOS G DEV
12SWW 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: "
13 D ^DIC G:"^"[X CLOS S SWZ=+Y K DIC G:Y'>0 CLOS S (SWB,SWA)=0
14DEV D EN1 I $D(ZTSK)!($D(OUT))!(POP) K ZTSK G CLOS
15ENQ D CLE S SWD=SOWKFD-1 F I=0:0 S SWD=$O(^SOWK(650,"ACD",SWD)) Q:SWD>SOWKFB!'SWD F F=0:0 S F=$O(^SOWK(650,"ACD",SWD,F)) Q:'F S E=^SOWK(650,F,0),W=$P(E,"^",3) D
16 .I $S(SWB:$P(^VA(200,W,654),"^",2)=SWZ,('SWA&'SWB):$P(E,"^",3)=SWZ,1:1) D CAT
17 D CAL G CLOS
18CAT F P=0:0 S P=$O(^SOWK(650,F,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
19 Q
20CLE S (TOT,VT,HT,TOTB)=0 S X=1
21 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
22 Q
23CLOS I $G(SOWKAB)'="ALL" W:$E(IOST)'["C" @IOF D ^%ZISC K SWA,SWB,SOWKFD,SOWKFB,SOWKAB,SWZ,X
24 I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT1=1
25 K %,%Y,D,L,Y,OUT,OUT1,W,SWD,F,%DT,HT,K,Q,TOT,TOTB,VT,C,T,TO,IM,SW,SWXX,PT,VT,I,P,E,DIC,IOP,POP D:$D(ZTSK) KILL^%ZTLOAD
26 Q
27EN1 W !!,"WARNING !!!",!?5,"This report is formatted for 132 columns and will be",!?5,"difficult to read if printed to the screen.",!
28 K ZTSK,OUT,%ZIS,IOP S SOWKION=ION,%ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K SOWKION,IOP S POP=1 Q
29 K SOWKION I $D(IO("Q")) S ZTRTN="ENQ^SOWKPAO" F G="SOWKAB","X","SOWKFD","SWZ","SOWKFB","SWB","SWA" S:$D(@G) ZTSAVE(G)=""
30 I K IO("Q") D ^%ZTLOAD K %DT,G I '$D(ZTSK) S OUT=1 Q
31 I $D(ZTSK) K %DT,G W !!,"Task Queued to Print",!
32 Q
33CAL ;CALCULATE/PRINT
34 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)
35 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)
36 F I=0:0 S I=$O(^SOWK(655.203,I)) Q:'I S VT=TO(I)+VT
37 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
38 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
39 S:TOT TOTB=(TOT/TOT)*100
40 U IO W:$Y @IOF W $S(SWA:"COMPLETE SERVICE",SWB:"SUPERVISOR "_$P(^VA(200,SWZ,0),"^"),1:"SOCIAL WORKER "_$P(^VA(200,SWZ,0),"^")),!
41 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)
42 W ?45,"Problems and Outcomes Report",!!
43 W ?8,"CLINICAL",?22,"PLANNED",?32,"PARTIALLY",?45,"PARTIALLY",?58,"PARTIALLY"
44 W !?8,"DECISION",?22,"RESULTS",?32,"ATTAINED",?45,"ATTAINED",?58,"ATTAINED",?72,"NOT ATTAINED",?87,"NOT ATTAINED",?102,"NOT ATTAINED"
45 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,"%"
46 F I=0:0 S I=$O(^SOWK(655.201,I)) Q:'I!($G(OUT1)=1) D PRI
47 Q:$G(OUT1)=1
48 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)
49 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)
50 W !!?10,"NOTE: P/F=PATIENT/FAMILY, CR=COMMUNITY RESOURCES, BARR.=BARRIERS"
51 Q
52PRI 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)
53 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)
54 Q
55CHK ;
56 Q:($Y+5)'>IOSL
57 N SWXX
58 I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT1=1
59 W @IOF
60 Q
Note: See TracBrowser for help on using the repository browser.