[613] | 1 | SOWKRCS ;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
|
---|
| 3 | BEG S %DT="AEXP",%DT("A")="ALL CASES STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SWB=Y
|
---|
| 4 | END S %DT("A")="ALL CASES ENDING: " D ^%DT G:"^"[X CLOS G:Y'>0 END S SWE=Y
|
---|
| 5 | DEV ;
|
---|
| 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
|
---|
| 9 | ENQ 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
|
---|
| 14 | CLOS 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
|
---|
| 17 | OUT ;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
|
---|
| 36 | NP W !,"NO DAYS OF CARE FOR ",$P(F,U),!!!!
|
---|
| 37 | Q
|
---|
| 38 | SEA 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
|
---|
| 64 | COM ;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
|
---|