source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKRCS.m@ 1553

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1SOWKRCS ;B'HAM ISC/SAB-Routine to print RCS 10-0173 report ; 08 Dec 93 / 9:24 AM [ 09/23/97 2:14 PM ]
2 ;;3.0;Social Work;**17,32,40,53**;04/27/93
3BEG S %DT="AEXP",%DT("A")="ALL CASES STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SWB=Y
4END S %DT("A")="ALL CASES ENDING: " D ^%DT G:"^"[X CLOS G:Y'>0 END S SWE=Y
5DEV ;
6 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
7 I $D(IO("Q")) S ZTDESC="RCS AMIS REPORT 10-0173",ZTRTN="ENQ^SOWKRCS" F G="SWB","SWE" S:$D(@G) ZTSAVE(G)=""
8 I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued to Print",! K ZTSK,G,SWB,SWE,SOWKION G CLOS Q
9ENQ N STA ;STA must be newed
10 S Y=SWB,OUT=0 X ^DD("DD") S SBD=Y,Y=SWE X ^DD("DD") S SED=Y U IO W:$Y @IOF W ?14,"RCS 10-0173 AMIS REPORT "_SBD_" TO "_SED,!!
11 F B=0:0 S B=$O(^SOWK(652,B)) Q:'B S (SWD(B),SWQ(B))=0
12 F B=0:0 S B=$O(^SOWK(655,B)) Q:'B S F=^(B,0) F HM=0:0 S HM=$O(^SOWK(655,$P(F,U),4,HM)) Q:'HM S RCH=^SOWK(655,$P(F,U),4,HM,0) D SEA
13 F B=0:0 S B=$O(^SOWK(652,B)) Q:'B!(OUT=1) S F=^SOWK(652,B,0) D OUT
14CLOS W:$E(IOST)'["C" @IOF D ^%ZISC
15 K %DT,A,B,CCD,F,HCD,HER,HM,HOD,HOME,LER,OUT,POP,R,RCH,SBD,SED,SOWKCLOS,SOWKION,SWA,SWB,SWD,SWE,SWHS,SWL,SWMR,SWQ,SWVO,SWZ,X,X1,X2,Y,ZTDESC,ZTRTN,ZTSAVE D:$D(ZTSK) KILL^%ZTLOAD
16 Q
17OUT ;CALCULATE and PRINT
18 S SWHS=$P(F,"^",7),STA=$P(^DIC(5,SWHS,0),"^"),SWZ=$P(F,"^",13)
19 S Y=SWZ X ^DD("DD") S SWZ=Y,SWL=$S($P(F,"^",10)="Y":"YES",1:"NO"),SWVO=$S($P(F,"^",12)="Y":"YES",1:"NO")
20 I 'SWD(B) D NP Q
21 I A(B) S SWA=A(B,1)/A(B)
22 E S SWA=0
23 W:($Y+10)>IOSL @IOF,?14,"RCS 10-0173 AMIS REPORT "_SBD_" TO "_SED,!!
24 W !,"1. STATION NO.",?51,$P(F,U,3)
25 W !,"2. NAME OF RCH",?51,$P(F,U)
26 W !,"3. & 4. HOME CITY STATE ZIP",?51,$P(F,U,6)_", "_STA_" "_$P(F,U,8)
27 W !,"5. DATE OF LAST ASSESSMENT",?51,SWZ
28 W !,"6. LICENSED BY STATE",?51,SWL
29 W !,"7. NO. OF VETS REMAINING AT END OF QTR.",?51,SWQ(B)
30 W !,"8. NO. OF DAYS OF CARE FOR VETERANS DURING QTR.",?51,SWD(B)
31 W !,"9. NO. OF BEDS IN HOME",?51,$P(F,U,11)
32 W !,"10. HOME FOR VETERANS ONLY",?51,SWVO
33 W !,"11. AVERAGE MONTHLY RATE PAID",?51,$S('SWA:SWA,1:$J(SWA,3,0)),!!!!
34 I $E(IOST)["C" R !!,"Press <RETURN> to continue: ",X:DTIME I X["^" S OUT=1
35 Q
36NP W !,"NO DAYS OF CARE FOR ",$P(F,U),!!!!
37 Q
38SEA N HCD,HOME,RNGE
39 S HOD=$P(RCH,U,2),HCD=$P(RCH,U,4),HOME=$P(RCH,U)
40 ;quit if Home close date is less than beginning date
41 I HCD<SWB&(HCD'="") Q
42 ;quit if Home open date is GREATER than ending date
43 I HOD>SWE Q
44 ;In order to calculate the number of days of care (SWD) we will need to
45 ;know the following:
46 ; SWB - Beginning date
47 ; SWE - Ending date
48 ; HOD - Date opened to Home
49 ; HCD - Date closed to Home
50 ; HER - High end range
51 ; LER - Low end range
52 ; SWQ - array for # of vets remaining
53 ; SWD - array for # of days of care
54 ;
55 ;set high end range, if close date is equal to or before ending date
56 I SWE'<HCD!(HCD'="") S HER=HCD
57 ;if close date is null or after ending date
58 I SWE<HCD!(HCD="") S HER=SWE S SWQ(HOME)=$G(SWQ(HOME))+1
59 S LER=SWB I HOD>SWB S LER=HOD
60 ;calculate days of care range
61 S X1=HER,X2=LER S RNGE=$$FMDIFF^XLFDT(X1,X2) S SWD(HOME)=(RNGE+$G(SWD(HOME)))
62 D COM
63 Q
64COM ;average monthly rat
65 S SWMR=0
66 F R=0:0 S R=$O(^SOWK(655,$P(F,"^"),4,HM,1,R)) Q:'R S SWMR=$P(^SOWK(655,$P(F,"^"),4,HM,1,R,0),"^") D
67 .S A($P(RCH,"^"),1)=SWMR+$G(A($P(RCH,"^"),1)),A($P(RCH,U))=$G(A($P(RCH,U)))+1
68 Q
Note: See TracBrowser for help on using the repository browser.