| [613] | 1 | ECTPAS0 ;B'ham ISC/PTD-PAID Data for All Services - CONTINUED ;01/29/91 08:00
|
|---|
| 2 | V ;;1.05;INTERIM MANAGEMENT SUPPORT;**4,8,10**;
|
|---|
| 3 | ENQ ;ENTRY POINT WHEN QUEUED
|
|---|
| 4 | K ^TMP($J) S SRVDA=0
|
|---|
| 5 | LP1 ;LOOP THROUGH ALL 'LOCAL' SERVICES AND THROUGH DATE/PAY PERIOD REQUESTED
|
|---|
| 6 | F L=0:0 S SRVDA=$O(^ECC(730,"ALS",SRVDA)) G:'SRVDA EN1^ECTPAS1 S YP=(BYRPP-1) F J=0:0 S YP=$O(^PRST(455,YP)) Q:'YP Q:YP>EYRPP S (EMPDA,PAL,PSL,PLWOP,PAA,PCTE,PCTU,PUNS,POT)=0 D LP2 D:$D(TMP(SRVDA,YP)) SETGL
|
|---|
| 7 | ;
|
|---|
| 8 | LP2 ;LOOP THROUGH ALL RECORDS FOR DATE/PAY PERIOD
|
|---|
| 9 | Q:'$O(^PRST(455,YP,0))
|
|---|
| 10 | EMP F K=0:0 S EMPDA=$O(^PRST(455,YP,1,EMPDA)) Q:'EMPDA S TL=$P(^PRST(455,YP,1,EMPDA,0),"^",7) G:TL="" EMP G:'$D(SRVTL(SRVDA,TL)) EMP D GTDTA
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | ;
|
|---|
| 14 | GTDTA ;FOR SELECTED PAY PERIOD, EXTRACT DATA FOR INDIVIDUAL
|
|---|
| 15 | I '$D(^PRST(455,YP,1,EMPDA,1)) S LOC0=^PRST(455,YP,1,EMPDA,0) F PC=1,2,3,6,7,11,12,13,17,18,19,47,48,49,50,51,53 S $P(LOC1,"^",PC)="000"
|
|---|
| 16 | I G CALC
|
|---|
| 17 | S LOC0=^PRST(455,YP,1,EMPDA,0),LOC1=^PRST(455,YP,1,EMPDA,1)
|
|---|
| 18 | CALC ;COMPUTE FIRST AND SECOND WEEK TOTALS FOR PAY PERIOD
|
|---|
| 19 | S (AL,SL,LWOP,AA,CTE,CTU,UNS,OT)=0
|
|---|
| 20 | PHYS ;IS INDIVIDUAL FULL-TIME PHYSICIAN OR RESIDENT
|
|---|
| 21 | I (($P(LOC0,"^",10)="J")!($P(LOC0,"^",10)="L")),($P(LOC0,"^",11)=1) D CONV G SETPP
|
|---|
| 22 | AL S AL1=$P(LOC0,"^",13),AL2=$P(LOC0,"^",48),AL=(($E(AL1,3)/4)+($E(AL1,1,2))+($E(AL2,3)/4)+($E(AL2,1,2)))
|
|---|
| 23 | SL S SL1=$P(LOC0,"^",14),SL2=$P(LOC0,"^",49),SL=(($E(SL1,3)/4)+($E(SL1,1,2))+($E(SL2,3)/4)+($E(SL2,1,2)))
|
|---|
| 24 | LWOP S LWOP1=$P(LOC0,"^",15),LWOP2=$P(LOC0,"^",50),LWOP=(($E(LWOP1,3)/4)+($E(LWOP1,1,2))+($E(LWOP2,3)/4)+($E(LWOP2,1,2)))
|
|---|
| 25 | AA S AA1=$P(LOC0,"^",17),AA2=$P(LOC0,"^",52),AA=(($E(AA1,3)/4)+($E(AA1,1,2))+($E(AA2,3)/4)+($E(AA2,1,2)))
|
|---|
| 26 | CTE S CTE1=$P(LOC0,"^",19),CTE2=$P(LOC1,"^"),CTE=(($E(CTE1,3)/4)+($E(CTE1,1,2))+($E(CTE2,3)/4)+($E(CTE2,1,2)))
|
|---|
| 27 | CTU S CTU1=$P(LOC0,"^",20),CTU2=$P(LOC1,"^",2),CTU=(($E(CTU1,3)/4)+($E(CTU1,1,2))+($E(CTU2,3)/4)+($E(CTU2,1,2)))
|
|---|
| 28 | UNS S UNS1=$P(LOC0,"^",21),UNS2=$P(LOC1,"^",3),UNS=(($E(UNS1,3)/4)+($E(UNS1,1,2))+($E(UNS2,3)/4)+($E(UNS2,1,2)))
|
|---|
| 29 | OT S (OT1,OT2)=0 F PC=25,29,30,31,33,35,36,37 S OT1=OT1+$P(LOC0,"^",PC) I $E(OT1,$L(OT1))>3 S OT1=OT1+6
|
|---|
| 30 | F PC=6,7,49 S OT1=OT1+$P(LOC1,"^",PC) I $E(OT1,$L(OT1))>3 S OT1=OT1+6
|
|---|
| 31 | F PC=11,12,13,17,18,19,47,48,50,51,53 S OT2=OT2+$P(LOC1,"^",PC) I $E(OT2,$L(OT2))>3 S OT2=OT2+6
|
|---|
| 32 | S OT1=$E("000",1,3-$L(OT1))_OT1,OT2=$E("000",1,3-$L(OT2))_OT2,OT=(($E(OT1,3)/4)+($E(OT1,1,2))+($E(OT2,3)/4)+($E(OT2,1,2)))
|
|---|
| 33 | SETPP ;INCREMENT PAY PERIOD COUNTERS FOR THIS INDIVIDUAL
|
|---|
| 34 | S PAL=PAL+AL,PSL=PSL+SL,PLWOP=PLWOP+LWOP,PAA=PAA+AA,PCTE=PCTE+CTE,PCTU=PCTU+CTU,PUNS=PUNS+UNS,POT=POT+OT
|
|---|
| 35 | S TMP(SRVDA,YP)=PAL_"^"_PSL_"^"_PLWOP_"^"_PAA_"^"_PCTE_"^"_PCTU_"^"_PUNS_"^"_POT
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | SETGL ;SET TMP GLOBAL
|
|---|
| 39 | S ^TMP($J,SRVDA,YP)=TMP(SRVDA,YP)
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | CONV ;CONVERT LEAVE DAYS INTO HOURS
|
|---|
| 43 | S X="",AL1=$E($P(LOC0,"^",13),2),AL2=$E($P(LOC0,"^",48),2),X=(((AL1+AL2)*40)/7) D RND S AL=X
|
|---|
| 44 | S X="",SL1=$E($P(LOC0,"^",14),2),SL2=$E($P(LOC0,"^",49),2),X=(((SL1+SL2)*40)/7) D RND S SL=X
|
|---|
| 45 | S X="",LWOP1=$E($P(LOC0,"^",15),2),LWOP2=$E($P(LOC0,"^",50),2),X=(((LWOP1+LWOP2)*40)/7) D RND S LWOP=X
|
|---|
| 46 | S X="",AA1=$E($P(LOC0,"^",17),2),AA2=$E($P(LOC0,"^",52),2),X=(((AA1+AA2)*40)/7) D RND S AA=X
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | RND ;ROUND TO NEAREST QUARTER HOUR
|
|---|
| 50 | S FR=$E($P(X,".",2),1,2),WH=$P(X,".")
|
|---|
| 51 | S FR=$S((FR<13):0,((FR>12)&(FR<38)):25,((FR>37)&(FR<63)):5,((FR>62)&(FR<88)):75,1:"Z") I FR="Z" S FR=0,WH=WH+1
|
|---|
| 52 | S X=WH_"."_FR
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
