source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKCLSS.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1SOWKCLSS ;B'HAM ISC/SAB,DLR-Routine to print clinical summary for all supervisors ; 08 Apr 93 / 3:57 PM [ 09/22/94 1:18 PM ]
2 ;;3.0; Social Work ;**34,53**;27 Apr 93
3 S Y=$S($O(^SOWK(650,"O",0)):$O(^SOWK(650,"O",0)),1:$E(DT,1,5)_"01") X ^DD("DD") S %DT("B")=Y
4BEG W ! K ^TMP($J) S %DT="AEXP",%DT("A")="ALL CASES"_$S(COM=2:" CLOSED ",COM=3:" OPENED ",1:" ")_"STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S (SOWKBEG,SOWKBG)=Y,PG=0
5 W ! K %DT("B") S %DT(0)=Y,%DT("A")="ENDING: " D ^%DT G:"^"[$E(X) CLOS S SOWKED=Y
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 %ZIS,IOP,ZTSK S SOWKION=ION,%ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K IOP,SOWKION G CLOS
8 K SOWKION I $D(IO("Q")) S ZTDESC="CLINICAL SUMMARY FOR ALL SUPERVISORS",ZTRTN="EN^SOWKCLSS" F G="SOWKED","SOWKBEG","COM","SOWKBG" S:$D(@G) ZTSAVE(G)=""
9 I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued to Print" K ZTSK G CLOS
10EN S %H=$H D YX^%DTC S TD=$P(Y,"@")_" "_$P(Y,"@",2)
11 G @$S(COM=2:"EN1",COM=3:"EN2",1:"EN0")
12EN0 S PG=0,SOWKBEG=SOWKBEG-1 F SOWKI=0:0 S SOWKBEG=$O(^SOWK(650,"O",SOWKBEG)) Q:'SOWKBEG F SOWKI1=0:0 S SOWKI1=$O(^SOWK(650,"O",SOWKBEG,SOWKI1)) Q:'SOWKI1 I SOWKBEG'>SOWKED S CN=^SOWK(650,SOWKI1,0) D SETUP
13 D SET1
14CLOS W ! W:$E(IOST)'["C" @IOF D ^%ZISC K COM,SOWKBG,SOWKED,^TMP($J),G,PG,SOWKBEG,%DT,SOWKI,SOWKI1,DS,CN,C,D,I,M,OC,OUT,PAT,T,X,Y,TD,PR,WRK,SUP,SP,%H,H D KVA^VADPT D:$D(ZTSK) KILL^%ZTLOAD
15 Q
16SETUP S SP=$P(^VA(200,$P(CN,"^",3),654),"^",2),C=0,(PR,OC)="" F I=0:0 S C=C+1,I=$O(^SOWK(650,SOWKI1,2,I)) Q:'I!(C>8) S PR=PR_$P(^SOWK(650,SOWKI1,2,I,0),"^")_" ",OC=OC_$P(^(0),"^",2)_" "
17 S C=0,DS="" F I=0:0 S C=C+1,I=$O(^SOWK(650,SOWKI1,5,I)) Q:'I!(C>8) S DS=DS_$P(^SOWK(650,SOWKI1,5,I,0),"^")_" "
18 S DFN=$P(CN,U,8) D PID^VADPT6
19 S ^TMP($J,$P(^VA(200,SP,0),"^"),$P(^VA(200,$P(CN,"^",3),0),"^"),$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_"^"_DS
20 Q
21PRI U IO I ($Y+5)>IOSL D HDR Q:$G(OUT)=1
22 W !,PAT,?32,$P(D,"^",2),?43,$P(D,"^",3),?62,$P(D,"^",4),?87,$P(D,"^",5),?107,$P(D,"^",6)
23 Q
24HDR D:PG'=0 CHK Q:$G(OUT)=1 S PG=PG+1,Y=SOWKBG X ^DD("DD") S SOWKBG=Y,Y=SOWKED X ^DD("DD") S SOWKED=Y
25 U IO W !,"SUPERVISORY CLINICAL SUMMARY - ALL SUPERVISORS"_$S(COM=2:" (CLOSED CASES) ",COM=3:" (OPENED CASES) ",1:" (ALL CASES) "),?89,TD,?121,"PAGE: "_PG
26 W !,$P(^DD("SITE"),"^")_" ("_$P(^DD("SITE",1),"^")_")",?45,"REPORTING PERIOD "_SOWKBG_" TO "_SOWKED
27 W !,"NAME",?32,"ID#",?43,"CDC LOCATION",?62,"PROBLEMS",?87,"OUTCOMES",?107,"DIRECT SERVICES",! F M=1:1:132 W "-"
28 Q
29SET1 S (WRK,PAT,SUP)="" W:$Y @IOF
30 F I=0:0 S SUP=$O(^TMP($J,SUP)) Q:SUP=""!($G(OUT)=1) D HDR Q:$G(OUT)=1 U IO W !?8,"SUPERVISOR: "_SUP F G=0:0 S WRK=$O(^TMP($J,SUP,WRK)) Q:WRK=""!($G(OUT)=1) W !!?11,"SOCIAL WORKER: "_WRK D
31 .F H=0:0 S PAT=$O(^TMP($J,SUP,WRK,PAT)) Q:PAT=""!($G(OUT)=1) F T=0:0 S T=$O(^TMP($J,SUP,WRK,PAT,T)) Q:'T!($G(OUT)=1) S D=^TMP($J,SUP,WRK,PAT,T) D PRI
32 Q
33EN1 S PG=0,SOWKBEG=SOWKBEG-1 F SOWKI=0:0 S SOWKBEG=$O(^SOWK(650,"ACD",SOWKBEG)) Q:'SOWKBEG F SOWKI1=0:0 S SOWKI1=$O(^SOWK(650,"ACD",SOWKBEG,SOWKI1)) Q:'SOWKI1 I SOWKBEG'>SOWKED S CN=^SOWK(650,SOWKI1,0) D SETUP
34 D SET1 G CLOS
35 Q
36EN2 S PG=0,SOWKBEG=SOWKBEG-1 F SOWKI=0:0 S SOWKBEG=$O(^SOWK(650,"O",SOWKBEG)) Q:'SOWKBEG F SOWKI1=0:0 S SOWKI1=$O(^SOWK(650,"O",SOWKBEG,SOWKI1)) Q:'SOWKI1 I '$P(^SOWK(650,SOWKI1,0),"^",18),SOWKBEG'>SOWKED S CN=^SOWK(650,SOWKI1,0) D SETUP
37 D SET1 G CLOS
38 Q
39CHK ;
40 N SWXX
41 I $E(IOST)["C" R !,"Press <RETURN> to continue: ",SWXX:DTIME I SWXX["^" S OUT=1
42 W @IOF
43 Q
Note: See TracBrowser for help on using the repository browser.