source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKRCH1.m@ 839

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1SOWKRCH1 ;B'HAM ISC/SAB-CONTINUATION OF SOWKRCH CALCULATE TOTALS ; 04/06/92 13:27 [ 09/29/94 8:19 AM ]
2 ;;3.0; Social Work ;**34**;27 Apr 93
3 F Y=0:0 S Y=$O(^SOWK(650.1,1,2,Y)) Q:'Y S SWTT=ST(Y)+SWTT
4 F Y=0:0 S Y=$O(^SOWK(650.1,1,2,Y)) Q:'Y S:SWTT STT(Y)=(ST(Y)/SWTT)*100,SWPTT=STT(Y)+SWPTT
5 F T=1:1:10 S SWTHT=LP(T)+SWTHT
6 F T=1:1:10 S:SWTHT LPP(T)=(LP(T)/SWTHT)*100,SWPT=LPP(T)+SWPT
7 F T=1:1:3 S SWPU=NB(T)+SWPU
8 F T=1:1:3 S:SWPU NBB(T)=(NB(T)/SWPU)*100,SWPP=NBB(T)+SWPP
9 D:($Y+10)>IOSL CHK^SOWKRCH Q:$G(OUT1)=1
10 W !?30,"PREVIOUS LIVING ARRANGEMENTS",!
11 W !?74,"VA CARE",!?8,"OWN",?16,"VA",?23,"VAH EXCESS",?35,"NON",?58,"NON",?67,"NON",?74,"CONTRACT"
12 W !?8,"HM",?15,"NHCU",?25,"60 DAYS",?35,"VAH",?40,"VA DOM",?48,"VA CNH",?57,"VA NH",?65,"VA RES.",?74,"NON NH",?83,"OTHER",?91,"TOTAL",! F F=1:1:96 W "-"
13 W !,"NO.",?8,$J(LP(1),3,0),?15,$J(LP(2),3,0),?25,$J(LP(3),3,0),?35,$J(LP(4),3,0),?42,$J(LP(5),3,0),?50,$J(LP(6),3,0),?59,$J(LP(7),3,0),?67,$J(LP(8),3,0),?76,$J(LP(9),3,0),?83,$J(LP(10),3,0),?92,$J(SWTHT,3,0)
14 W !,"%",?8,$J(LPP(1),3,0),?15,$J(LPP(2),3,0),?25,$J(LPP(3),3,0),?35,$J(LPP(4),3,0),?42,$J(LPP(5),3,0),?50,$J(LPP(6),3,0),?59,$J(LPP(7),3,0),?67,$J(LPP(8),3,0),?76,$J(LPP(9),3,0),?83,$J(LPP(10),3,0),?92,$J(SWPT,3,0),! F F=1:1:96 W "-"
15 D:($Y+10)>IOSL CHK^SOWKRCH Q:$G(OUT1)=1
16 W !!!?18,"LEVEL OF CARE CAPACITY",!!?14,"LIGHT",?21,"MODERATE",?30,"HEAVY",?38,"TOTAL"
17 W !?8 F F=1:1:41 W "-"
18 W !?8,"NO.",?14,$J(NB(1),3,0),?21,$J(NB(2),3,0),?30,$J(NB(3),3,0),?38,$J(SWPU,3,0)
19 W !?8,"%",?14,$J(NBB(1),3,0),?21,$J(NBB(2),3,0),?30,$J(NBB(3),3,0),?38,$J(SWPP,3,0),!?8 F F=1:1:41 W "-"
20 D:($Y+10)>IOSL CHK^SOWKRCH W !!!,"SPECIAL PATIENT POPULATION",!!?30,"TOTAL",?38,"PERCENT"
21 F I=0:0 S I=$O(^SOWK(650.1,1,2,I)) Q:'I D:($Y+5)>IOSL CHK^SOWKRCH W !,$P(^(I,0),"^"),?30,$J(ST(I),3,0),?38,$J(STT(I),3,0)
22 W !,"TOTAL",?30,$J(SWTT,3,0),?38,$J(SWPTT,3,0),!
23 D CHK^SOWKRCH
24 K W,SWPT,SWPU,SWPP,SWTT,SWPTT,ST,STT,LP,LPP,NB,NBB
25 Q
Note: See TracBrowser for help on using the repository browser.