1 | SOWKQAMN ;B'HAM ISC/SAB,DLR-Routine to print quality mgmt. monitor I report ; 20 Apr 93 / 7:59 AM [ 09/26/94 1:08 PM ]
|
---|
2 | ;;3.0; Social Work ;**34,53,54**;27 Apr 93
|
---|
3 | K ^TMP($J)
|
---|
4 | 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
|
---|
5 | 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 I SE1<SB1 W !,"Ending date must be after starting date ",! G BEG
|
---|
6 | DEV 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,%ZIS,IOP S SOWKION=ION,%ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K SOWKION,IOP G CLOS Q
|
---|
8 | K SOWKION I $D(IO("Q")) S ZTRTN="ENQ^SOWKQAMN",ZTDESC="QUALITY MGMT. MONITOR I REPORT - SOCIAL WORK" F G="SE1","SB1","SBA","SEA" S:$D(@G) ZTSAVE(G)=""
|
---|
9 | I K IO("Q") D ^%ZTLOAD I '$D(ZTSK) G CLOS
|
---|
10 | I $D(ZTSK) W !!,"Task Queued to Print",! K ZTSK G CLOS
|
---|
11 | ENQ S (TOT,TOP)=0 F SOWK=0:0 S SOWK=$O(^SOWK(650,SOWK)) Q:'SOWK D GET K PC
|
---|
12 | D PRI Q:$G(OUT)=1 W !,"TOTALS",?13,$J(TOT,3,0),?33,$J(TOP,3,0),?63,$S(TOT:$J((TOP/TOT)*100,3,0),1:$J("0",3,0))
|
---|
13 | CLOS W ! W:$E(IOST)'["C" @IOF D ^%ZISC K ^TMP($J),I2,SB1,CDC,CN,SBA,SEA,Y,SE1,IOP,OUT,POP,SOWK,%DT,I1,G,I,TOT,TOP,X D KVA^VADPT D:$D(ZTSK) KILL^%ZTLOAD
|
---|
14 | Q
|
---|
15 | ;CALCULATE TOTALS
|
---|
16 | CAL F I=0:0 S I=$O(^SOWK(650,SOWK,2,I)) Q:'I I $P(^SOWK(650,SOWK,2,I,0),"^")'<1,$P(^(0),"^")'>6 D:'$G(PC) DIS S PC=1
|
---|
17 | Q
|
---|
18 | DIS F I1=0:0 S I1=$O(^SOWK(650,SOWK,5,I1)) Q:'I1 I $P(^SOWK(655.202,$P(^SOWK(650,SOWK,5,I1,0),"^"),0),"^")="DISCHARGE PLANNING" S TOT=TOT+1 D SUB,POST
|
---|
19 | Q
|
---|
20 | POST F I2=0:0 S I2=$O(^SOWK(650,SOWK,5,I2)) Q:'I2 I $P(^SOWK(655.202,$P(^SOWK(650,SOWK,5,I2,0),"^"),0),"^")="POST DISCHARGE FOLLOW-UP" S ^TMP($J,CDC,"PF")=^TMP($J,CDC,"PF")+1,TOP=TOP+1
|
---|
21 | Q
|
---|
22 | PRI ;print data
|
---|
23 | U IO W:$Y @IOF D HDR1 F CDC=0:0 S CDC=$O(CDC(CDC)) Q:'CDC!($G(OUT)=1) D:($Y+10)>IOSL CHK Q:$G(OUT)=1 D
|
---|
24 | .W !,$P(^SOWK(651,CDC,0),"^",4),?13,$J(^TMP($J,CDC,"PR"),3,0),?33,$J(^TMP($J,CDC,"PF"),3,0),?63,$J((^TMP($J,CDC,"PF")/^TMP($J,CDC,"PR"))*100,3,0)
|
---|
25 | Q
|
---|
26 | HDR1 W !!?45,"Department of Veterans Affairs",!?44,$P(^DD("SITE"),"^")_" ("_$P(^DD("SITE",1),"^")_")",!?40,"Social Work Information Management System",!?45,"Quality Management Monitor I"
|
---|
27 | W !?35,"Follow-up of discharged inpatients who received",!?32,"""Discharged Planning"" and had ""Problems related to care""",!,"Date: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),?60,"Reporting Period "_SBA_" to "_SEA,!
|
---|
28 | W !,"Location",?10,"Total Patients",?30,"Post Discharge Follow-up",?60,"% rec'd Follow-up"
|
---|
29 | Q
|
---|
30 | SUB S:'$D(^TMP($J,CDC,"PR")) (^TMP($J,CDC,"PR"),^TMP($J,CDC,"PF"))=0 S CDC(CDC)="",^TMP($J,CDC,"PR")=^TMP($J,CDC,"PR")+1
|
---|
31 | Q
|
---|
32 | GET I $P(^SOWK(650,SOWK,0),"^",2)'<SB1,$P(^(0),"^",2)'>SE1,'$P(^(0),"^",18) S CN=^SOWK(650,SOWK,0),CDC=$P(CN,"^",13) D CAL Q
|
---|
33 | I $P(^SOWK(650,SOWK,0),"^",18)'<SB1,$P(^(0),"^",18)'>SE1 S CN=^SOWK(650,SOWK,0),CDC=$P(CN,"^",13) D CAL
|
---|
34 | Q
|
---|
35 | CHK ;
|
---|
36 | N SWXX
|
---|
37 | I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT=1 W @IOF Q
|
---|
38 | W @IOF D HDR1
|
---|
39 | Q
|
---|