source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKQAM5.m@ 1716

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1SOWKQAM5 ;B'HAM ISC/SAB,DLR-Routine to print quality mgmt. monitor V report ; 20 Apr 93 / 7:58 AM [ 09/26/94 8:44 AM ]
2 ;;3.0; Social Work ;**34,53,64**;27 Apr 93;Build 6
3 ;Reference to GETPLIST^SDAMA202 supported by IA #3869
4 ;Reference to ^DIC(40.7 supported by IA #557
5 ;
6BEG 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
7END 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
8DEV W !!,"WARNING !!!",!?5,"This report is formatted for 132 columns and will be",!?5,"difficult to read if printed to the screen.",!
9 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
10 K SOWKION I $D(IO("Q")) S ZTRTN="ENQ^SOWKQAM5",ZTDESC="QUALITY MGMT. MONITOR V REPORT - SOCIAL WORK" F G="SE1","SB1","SBA","SEA" S:$D(@G) ZTSAVE(G)=""
11 I K IO("Q") D ^%ZTLOAD I '$D(ZTSK) G CLOS
12 I $D(ZTSK) W !!,"Task Queued to Print",! K ZTSK G CLOS
13ENQ ;
14 F I=0:0 S I=$O(^SOWK(650.1,1,4,I)) Q:'I D
15 . S SWCL=+^(I,0),SWCC=$G(^DIC(40.7,$P($G(^SC(SWCL,0)),"^",7),0)),SWCL(SWCL)=SWCL_"^"_$P(SWCC,"^",2)_"^"_$P(SWCC,"^",5)
16 S (TOT1,TOT2)=0
17 F SWCL=0:0 S SWCL=$O(SWCL(SWCL)) Q:'SWCL D
18 . S CL=$P(SWCL(SWCL),"^"),CLP=$P(SWCL(SWCL),"^",2)
19 . S CLS=0 D SWCL S CLS=1 D TOC
20 ;
21 D PRI I $G(OUT)'=1 W !?64,"----",?90,"----",?118,"----",!,"TOTALS",?65,$J(TOT1,3,0),?91,$J(TOT2,3,0),?119,$S(TOT2:$J((TOT1/TOT2)*100,3,0)_"%",1:"***")
22 ;
23CLOS W ! W:$E(IOST)'["C" @IOF D ^%ZISC
24 K CL,ID,CLP,CLS,DFN,I,ZZ,I2,SB1,CDC,CN,SBA,SEA,Y,TOT1,TOT2,SE1,IOP,OUT,POP,SOWK,%DT,I1,G,SWCC,X,SWCL
25 D KVA^VADPT D:$D(ZTSK) KILL^%ZTLOAD
26 Q
27TOC ;
28 F CL=0:0 S CL=$O(^SC(CL)) Q:'CL D
29 . I $P($G(^SC(CL,0)),"^",7)'="" D
30 . . I CLP=$P($G(^DIC(40.7,$P(^SC(CL,0),"^",7),0)),U,2) D SWCL
31 Q
32 ;CALCULATE TOTALS
33SWCL ;
34 K ^TMP($J,"SDAMA202","GETPLIST")
35 D GETPLIST^SDAMA202(CL,"3;12",,SB1,SE1)
36 F ID=0:0 S ID=$O(^TMP($J,"SDAMA202","GETPLIST",ID)) Q:'ID D
37 . I $G(^TMP($J,"SDAMA202","GETPLIST",ID,3))="R",$G(^TMP($J,"SDAMA202","GETPLIST",ID,12))="O" D
38 . . S $P(SWCL(SWCL),"^",$S(CLS:5,1:4))=$P(SWCL(SWCL),"^",$S(CLS:5,1:4))+1
39 K ^TMP($J,"SDAMA202","GETPLIST")
40 Q
41PRI ;print data
42 U IO W:$Y @IOF D HDR1 Q:$G(OUT)=1 F CDC=0:0 S CDC=$O(SWCL(CDC)) Q:'CDC!($G(OUT)=1) D:($Y+13)>IOSL CHK D:$G(OUT)'=1 OUT
43 Q
44HDR1 W !!?45,"Department of Veterans Affairs",!?45,$P(^DD("SITE"),"^")_" ("_$P(^DD("SITE",1),"^")_")",!?40,"Social Work Information Management System",!?45,"Quality Management Monitor V"
45 W !?40,"Access to Social Work Services by Location",!,"Date: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),?60,"Reporting Period "_SBA_" to "_SEA,!
46 W !?34,"Stop",?60,"# Pats. Open/",?86,"Total # Patients",?116,"% Population",!,"Clinic",?34,"Code",?46,"Location",?60,"# PT. Visits",?86,"Treatment Episodes",?118,"Served",!
47 Q
48OUT W !,$P(^SC($P(SWCL(CDC),"^"),0),"^"),?35,$P(SWCL(CDC),"^",2)
49 W ?46,$P(SWCL(CDC),"^",3),?65,$J($P(SWCL(CDC),"^",4),3,0),?91,$J($P(SWCL(CDC),"^",5),3,0),?119,$S(+$P(SWCL(CDC),"^",5):$J(+$P(SWCL(CDC),"^",4)/+$P(SWCL(CDC),"^",5)*100,3,0),1:$J("0",3,0))
50 S TOT1=TOT1+$P(SWCL(CDC),"^",4),TOT2=TOT2+$P(SWCL(CDC),"^",5)
51 Q
52CHK ;
53 N SWXX
54 I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT=1 W @IOF Q
55 W @IOF D HDR1
56 Q
Note: See TracBrowser for help on using the repository browser.