source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKQAMR.m@ 701

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1SOWKQAMR ;B'HAM ISC/SAB-Routine to print quality mgmt. review I report ; 20 Apr 93 / 8:00 AM [ 09/26/94 1:11 PM ]
2 ;;3.0; Social Work ;**34,53**;27 Apr 93
3 K ^TMP($J)
4BEG 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
5END 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
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,%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^SOWKQAMR",ZTDESC="QUALITY MGMT. REVIEW 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
11ENQ F SOWKWRK=0:0 S SOWKWRK=$O(^SOWK(650,"W",SOWKWRK)) Q:'SOWKWRK F SOWK=0:0 S SOWK=$O(^SOWK(650,"W",SOWKWRK,SOWK)) Q:'SOWK D CAL1
12 W:$Y @IOF D HDR1 D:$G(OUT)'=1 PRI
13CLOS W ! W:$E(IOST)'["C" @IOF D ^%ZISC K ^TMP($J),CD,D,DFN,OD,OUT,PAT,PF,SOWKI,SOWKWRK,T,WRK,SOWKI2,SB1,CDC,CN,SBA,SEA,Y,SE1,IOP,POP,SOWK,%DT,SOWKI1,G,I,X D KVA^VADPT D:$D(ZTSK) KILL^%ZTLOAD
14 Q
15CAL1 I $P(^SOWK(650,SOWK,0),"^",2)'<SB1,$P(^(0),"^",2)'>SE1,'$P(^(0),"^",18) D CAL Q
16 I $P(^SOWK(650,SOWK,0),"^",18)'<SB1,$P(^(0),"^",18)'>SE1 D CAL
17 Q
18CAL ;CALCULATE TOTALS
19 S CN=^SOWK(650,SOWK,0),CDC=$P(CN,"^",13)
20 F SOWKI=0:0 S SOWKI=$O(^SOWK(650,SOWK,2,SOWKI)) Q:'SOWKI I $P(^SOWK(650,SOWK,2,SOWKI,0),"^")'<1,$P(^(0),"^")'>6 D DIS
21 Q
22DIS F SOWKI1=0:0 S SOWKI1=$O(^SOWK(650,SOWK,5,SOWKI1)) Q:'SOWKI1 I $P(^SOWK(655.202,$P(^SOWK(650,SOWK,5,SOWKI1,0),"^"),0),"^")="DISCHARGE PLANNING" D POST
23 Q
24POST F SOWKI2=0:0 S SOWKI2=$O(^SOWK(650,SOWK,5,SOWKI2)) Q:'SOWKI2 I $P(^SOWK(655.202,$P(^SOWK(650,SOWK,5,SOWKI2,0),"^"),0),"^")="POST DISCHARGE FOLLOW-UP" S PF=1
25 I '$G(PF) S:'$D(WRK(SOWKWRK)) WRK(SOWKWRK)=0 S WRK(SOWKWRK)=WRK(SOWKWRK)+1 D SETUP
26 K PF
27 Q
28PRI ;print data
29 S (WRK,PAT)=""
30 F I=0:0 S WRK=$O(^TMP($J,WRK)) Q:WRK=""!($G(OUT)=1) D PRI1 Q:$G(OUT)=1 W !!,"Total Patients: "_^TMP($J,WRK)
31 Q
32PRI1 D CHK Q:$G(OUT)=1 U IO W !?8,"SOCIAL WORKER: "_WRK,!?11,"SUPERVISOR: "_^TMP($J,WRK) F G=0:0 S PAT=$O(^TMP($J,WRK,PAT)) Q:PAT=""!($G(OUT)=1) F T=0:0 S T=$O(^TMP($J,WRK,PAT,T)) Q:'T!($G(OUT)=1) D
33 .S D=^TMP($J,WRK,PAT,T),^TMP($J,WRK)=^TMP($J,WRK)+1 D CHK Q:$G(OUT)=1 W !,$P(D,"^"),?40,$P(D,"^",2),?50,$P(D,"^",3),?60,$P(D,"^",4),?77,$P(D,"^",5)
34 Q
35HDR1 U IO W !!?45,"Department of Veterans Affairs",!?44,$P(^DD("SITE"),"^")_" ("_$P(^DD("SITE",1),"^")_")",!?40,"Social Work Information Management System",!?45,"Quality Management Review I"
36 W !?35,"Non-Followup 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,!
37 W !,"Name",?40,"ID#",?50,"Location",?60,"Date Opened",?77,"Date Closed"
38 Q
39SETUP S DFN=$P(CN,"^",8) D DEM^VADPT,PID^VADPT6 S OD=$E($P(CN,"^",2),4,5)_"/"_$E($P(CN,"^",2),6,7)_"/"_$E($P(CN,"^",2),2,3),CD=$S($P(CN,"^",18):$E($P(CN,"^",18),4,5)_"/"_$E($P(CN,"^",18),6,7)_"/"_$E($P(CN,"^",18),2,3),1:"")
40 S:'$D(^TMP($J,$P(^VA(200,$P(CN,"^",3),0),"^"))) ^TMP($J,$P(^VA(200,$P(CN,"^",3),0),"^"))=$P(^VA(200,$P(^VA(200,$P(CN,"^",3),654),"^",2),0),"^")
41 S ^TMP($J,$P(^VA(200,$P(CN,"^",3),0),"^"),VADM(1),+CN)=VADM(1)_"^"_VA("BID")_"^"_$P(^SOWK(651,$P(CN,"^",13),0),"^",4)_"^"_OD_"^"_CD
42 Q
43CHK ;
44 Q:($Y+5)'>IOSL
45 N SWXX
46 I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT=1 W @IOF Q
47 W @IOF
48 Q
Note: See TracBrowser for help on using the repository browser.