source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURARWL5.m@ 1780

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

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1NURARWL5 ;HIRMFO/MD-MANHOURS AMIS 1106a WORK LOAD STATISTICS CONT OF NURARWL4 ;9/20/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3 I $G(NWARD) S NDATE="" D HEADER^NURARWL8
4 S NDATE=0 F S NDATE=$O(^TMP($J,NDATE)) Q:NDATE'>0 D:$G(NWARD)&'($G(NURSUMSW)) DATE^NURARWL8 D Q:$G(NUROUT) I $G(NURSUMSW)!($G(NWARD)="") D DAYTL^NURARWL7 Q:$G(NUROUT) S:'NURMDSW NBRK=0
5 .S NPFAC="" F S NPFAC=$O(^TMP($J,NDATE,NPFAC)) Q:NPFAC="" D:'$G(NWARD) HEADER^NURARWL8 D Q:$G(NUROUT) I NURMDSW,$G(NWARD)="" D FACTOT^NURARWL9
6 ..S NPLOC="" F S NPLOC=$O(^TMP($J,NDATE,NPFAC,NPLOC)) Q:NPLOC="" D Q:$G(NUROUT) D BRK^NURARWL6 Q:$G(NUROUT) S NBRK=0
7 ...S NSEC="" F S NSEC=$O(^TMP($J,NDATE,NPFAC,NPLOC,NSEC)) Q:NSEC="" D Q:$G(NUROUT) D AVG^NURARWL8,BEDTOT^NURARWL6 Q:$G(NUROUT)
8 ....S NSHFT=0 F S NSHFT=$O(^TMP($J,NDATE,NPFAC,NPLOC,NSEC,NSHFT)) Q:NSHFT'>0 D Q:$G(NUROUT)
9 .....S NDA=0 F S NDA=$O(^TMP($J,NDATE,NPFAC,NPLOC,NSEC,NSHFT,NDA)) Q:NDA'>0!($G(NUROUT)) S D1=0 F S D1=$O(^TMP($J,NDATE,NPFAC,NPLOC,NSEC,NSHFT,NDA,D1)) Q:D1'>0 D DETAIL Q:$G(NUROUT)
10 .....Q
11 ....Q
12 ...Q
13 ..Q
14 .Q
15 Q
16DETAIL ; DETAIL LINE PROCESSING
17 S (NBSEC,X)=0 F S X=$O(^TMP($J,NDATE,NPFAC,NPLOC,X)) Q:X="" S NBSEC=NBSEC+1
18 S NADATA=^NURSA(213.4,NDA,1,D1,0),NJ=$P(NADATA,U) Q:NJ'>0!('$D(^NURSF(213.3,NJ,1))) S NL1=^TMP($J,NDATE,NPFAC,NPLOC,NSEC,NSHFT,NDA,D1)
19 F Z=1:1:5 S $P(NPC(NSHFT),U,Z)=0
20 S NPCC(NSHFT)=0 F Z=1,2,3 S $P(NREQ(NSHFT),U,Z)=0,$P(NVAR(NSHFT),U,Z)=0 S $P(NPROD(NSHFT),U,Z)=$S(NURSZAP'>6:0,1:"")
21 ;
22 ; DETAIL CALCULATIONS FOR PERCENTAGES-VARIANCES-PERCENT PRODUCTIVITY
23 ;
24 S NURS213=^NURSF(213.3,NJ,1),SECT=$P(NURS213,U),NPERCEN=0 F X=1:1:5 S $P(NPC(NSHFT),U,X)=+$P(NADATA,U,(X+1)),NPCC(NSHFT)=NPCC(NSHFT)+$P(NPC(NSHFT),U,X)
25 F X="DOM","REC","HEM" I SECT=X S (COUNTSW,COUNTSW(1))=1
26 I +^TMP($J,"CEN",NDATE,NPFAC,NPLOC,NSHFT) S NPERCEN=(NPCC(NSHFT)/^TMP($J,"CEN",NDATE,NPFAC,NPLOC,NSHFT))
27 ;
28 ; CALCULATE SHIFT REQUIRED STAFF
29 ;
30 S:NSHFT=2 NTLFTEE(2)=(($P(NPC(2),U)*$P(NURS213,U,2))+($P(NPC(2),U,2)*$P(NURS213,U,3))+($P(NPC(2),U,3)*$P(NURS213,U,4))+($P(NPC(2),U,4)*$P(NURS213,U,5))+($P(NPC(2),U,5)*$P(NURS213,U,14)))/8.5
31 S:NSHFT=3 NTLFTEE(3)=(($P(NPC(3),U)*$P(NURS213,U,6))+($P(NPC(3),U,2)*$P(NURS213,U,7))+($P(NPC(3),U,3)*$P(NURS213,U,8))+($P(NPC(3),U,4)*$P(NURS213,U,9))+($P(NPC(3),U,5)*$P(NURS213,U,15)))/8.5
32 S:NSHFT=1 NTLFTEE(1)=(($P(NPC(1),U)*$P(NURS213,U,10))+($P(NPC(1),U,2)*$P(NURS213,U,11))+($P(NPC(1),U,3)*$P(NURS213,U,12))+($P(NPC(1),U,4)*$P(NURS213,U,13))+($P(NPC(1),U,5)*$P(NURS213,U,16)))/8
33 ;
34 ; GET MANHOURS DATA AND CONVERT TO FTEE
35 ;
36 S X=$S($D(^NURSA(213.4,NDA,0)):^(0),1:"0^0^0^0"),$P(NFTEE(NSHFT),U)=$S($P(X,U,2):$P(X,U,2)/8,1:0),$P(NFTEE(NSHFT),U,2)=$S($P(X,U,3):$P(X,U,3)/8,1:0),$P(NFTEE(NSHFT),U,3)=$S($P(X,U,4):$P(X,U,4)/8,1:0)
37 ;
38 ; CHECK PROF PERCENTAGE
39 ;
40 S Z=NTLFTEE(NSHFT) I $D(^NURSF(211.4,NL1,1)),$P(^(1),U,2) S Y=^(1),NTLFTEE("PROF")=Z/(100/$P(Y,U,2)) S NTLFTEE("NPROF")=$S($P(Y,U,2)<100:Z/(100/(100-$P(Y,U,2))),1:0)
41 E S Y=^DIC(213.9,1,0),NTLFTEE("PROF")=Z/(100/$P(Y,U,7)) S NTLFTEE("NPROF")=$S($P(Y,U,7)<100:Z/(100/(100-$P(Y,U,7))),1:0)
42 S $P(NREQ(NSHFT),U)=NTLFTEE("PROF"),$P(NREQ(NSHFT),U,2)=(NTLFTEE("NPROF")/2),$P(NREQ(NSHFT),U,3)=(NTLFTEE("NPROF")/2)
43 D ALLOCATE^NURARWL4
44 S:NPCC(NSHFT) NAVG=NAVG+1
45 D PRINT^NURARWL7
46 ;
47 ; ACCUMULATE BED SEC TOTALS
48 ;
49 F X=1:1:5 S $P(NBPC,U,X)=$P(NBPC,U,X)+$P(NPC(NSHFT),U,X)
50 S NBPCC=NBPCC+NPCC(NSHFT) I COUNTSW,'(SECT="HEM"),'(SECT="REC"),'(SECT="DOM") S COUNTSW=0
51 Q
Note: See TracBrowser for help on using the repository browser.