SOWKQAR4 ;B'HAM ISC/SAB-Routine to print quality mgmt. review IV ; 20 Apr 93 / 8:01 AM [ 09/26/94 10:27 AM ] ;;3.0; Social Work ;**34,53**;27 Apr 93 BEG W ! K ^TMP($J) S %DT="AEXP",%DT("A")="ALL CASES STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SB1=Y,PG=0 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 SE18) I $P(^SOWK(650,SOWK,2,I,0),"^",2)'<6,$P(^(0),"^",2)'>8 D SETUP1 Q SETUP1 S PR=PR_$P(^SOWK(650,SOWK,2,I,0),"^")_" ",OC=OC_$P(^(0),"^",2)_" " S:'$D(^TMP($J,WRK)) ^TMP($J,WRK)=0 S DFN=$P(CN,U,8) D PID^VADPT6 S ^TMP($J,WRK,$P(^DPT($P(CN,"^",8),0),"^"),+CN)=$P(^DPT($P(CN,"^",8),0),"^")_"^"_VA("BID")_"^"_$P(^SOWK(651,$P(CN,"^",13),0),"^",4)_"^"_PR_"^"_OC Q PRI U IO D:($Y+15)>IOSL CHK I $G(OUT)'=1 W !,PAT,?32,$P(D,"^",2),?43,$P(D,"^",3),?62,$P(D,"^",4),?89,$P(D,"^",5),?107,$P(D,"^",6) Q HDR S PG=PG+1 U IO W !!?45,"Department of Veterans Affairs",!?45,STA_" ("_STN_")",!?40,"Social Work Information Management System",!?45,"Quality Management Review IV" W !?39,"Level of problem resolution by problem code",!?52,"Unresolved problems",!!,"Date: "_TD,?45,"Reporting Period: "_SB1_" to "_SE1,!,"Worker's #: "_WRK,! W !,"NAME",?32,"ID#",?43,"CDC LOCATION",?62,"PROBLEMS",?87,"OUTCOMES" Q SET1 S (WRK,PAT)="" W:$Y @IOF F I=0:0 S WRK=$O(^TMP($J,WRK)) Q:WRK=""!($G(OUT)=1) D SET2 I $G(OUT)'=1 W !!,"Total Patients: "_^TMP($J,WRK) Q SET2 D HDR 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) S D=^TMP($J,WRK,PAT,T),^TMP($J,WRK)=^TMP($J,WRK)+1 D PRI Q GET I $P(^SOWK(650,SOWK,0),"^",2)'SE1,'$P(^(0),"^",18) S CN=^SOWK(650,SOWK,0) D SETUP Q I $P(^SOWK(650,SOWK,0),"^",18)'SE1 S CN=^SOWK(650,SOWK,0) D SETUP Q CHK ; N SWXX I $E(IOST)["C" R !,"Press to continue: ",SWXX:DTIME I SWXX["^" S OUT=1 W @IOF Q W @IOF D HDR Q