- NURARWL5 ;HIRMFO/MD-MANHOURS AMIS 1106a WORK LOAD STATISTICS CONT OF NURARWL4 ;9/20/96
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- I $G(NWARD) S NDATE="" D HEADER^NURARWL8
- 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
- .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
- ..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
- ...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)
- ....S NSHFT=0 F S NSHFT=$O(^TMP($J,NDATE,NPFAC,NPLOC,NSEC,NSHFT)) Q:NSHFT'>0 D Q:$G(NUROUT)
- .....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)
- .....Q
- ....Q
- ...Q
- ..Q
- .Q
- Q
- DETAIL ; DETAIL LINE PROCESSING
- S (NBSEC,X)=0 F S X=$O(^TMP($J,NDATE,NPFAC,NPLOC,X)) Q:X="" S NBSEC=NBSEC+1
- 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)
- F Z=1:1:5 S $P(NPC(NSHFT),U,Z)=0
- 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:"")
- ;
- ; DETAIL CALCULATIONS FOR PERCENTAGES-VARIANCES-PERCENT PRODUCTIVITY
- ;
- 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)
- F X="DOM","REC","HEM" I SECT=X S (COUNTSW,COUNTSW(1))=1
- I +^TMP($J,"CEN",NDATE,NPFAC,NPLOC,NSHFT) S NPERCEN=(NPCC(NSHFT)/^TMP($J,"CEN",NDATE,NPFAC,NPLOC,NSHFT))
- ;
- ; CALCULATE SHIFT REQUIRED STAFF
- ;
- 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
- 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
- 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
- ;
- ; GET MANHOURS DATA AND CONVERT TO FTEE
- ;
- 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)
- ;
- ; CHECK PROF PERCENTAGE
- ;
- 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)
- 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)
- S $P(NREQ(NSHFT),U)=NTLFTEE("PROF"),$P(NREQ(NSHFT),U,2)=(NTLFTEE("NPROF")/2),$P(NREQ(NSHFT),U,3)=(NTLFTEE("NPROF")/2)
- D ALLOCATE^NURARWL4
- S:NPCC(NSHFT) NAVG=NAVG+1
- D PRINT^NURARWL7
- ;
- ; ACCUMULATE BED SEC TOTALS
- ;
- F X=1:1:5 S $P(NBPC,U,X)=$P(NBPC,U,X)+$P(NPC(NSHFT),U,X)
- S NBPCC=NBPCC+NPCC(NSHFT) I COUNTSW,'(SECT="HEM"),'(SECT="REC"),'(SECT="DOM") S COUNTSW=0
- Q
- NURARWL5 ;HIRMFO/MD-MANHOURS AMIS 1106a WORK LOAD STATISTICS CONT OF NURARWL4 ;9/20/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- +2 IF $GET(NWARD)
- SET NDATE=""
- DO HEADER^NURARWL8
- +3 SET NDATE=0
- FOR
- SET NDATE=$ORDER(^TMP($JOB,NDATE))
- IF NDATE'>0
- QUIT
- IF $GET(NWARD)&'($GET(NURSUMSW))
- DO DATE^NURARWL8
- Begin DoDot:1
- +4 SET NPFAC=""
- FOR
- SET NPFAC=$ORDER(^TMP($JOB,NDATE,NPFAC))
- IF NPFAC=""
- QUIT
- IF '$GET(NWARD)
- DO HEADER^NURARWL8
- Begin DoDot:2
- +5 SET NPLOC=""
- FOR
- SET NPLOC=$ORDER(^TMP($JOB,NDATE,NPFAC,NPLOC))
- IF NPLOC=""
- QUIT
- Begin DoDot:3
- +6 SET NSEC=""
- FOR
- SET NSEC=$ORDER(^TMP($JOB,NDATE,NPFAC,NPLOC,NSEC))
- IF NSEC=""
- QUIT
- Begin DoDot:4
- +7 SET NSHFT=0
- FOR
- SET NSHFT=$ORDER(^TMP($JOB,NDATE,NPFAC,NPLOC,NSEC,NSHFT))
- IF NSHFT'>0
- QUIT
- Begin DoDot:5
- +8 SET NDA=0
- FOR
- SET NDA=$ORDER(^TMP($JOB,NDATE,NPFAC,NPLOC,NSEC,NSHFT,NDA))
- IF NDA'>0!($GET(NUROUT))
- QUIT
- SET D1=0
- FOR
- SET D1=$ORDER(^TMP($JOB,NDATE,NPFAC,NPLOC,NSEC,NSHFT,NDA,D1))
- IF D1'>0
- QUIT
- DO DETAIL
- IF $GET(NUROUT)
- QUIT
- +9 QUIT
- End DoDot:5
- IF $GET(NUROUT)
- QUIT
- +10 QUIT
- End DoDot:4
- IF $GET(NUROUT)
- QUIT
- DO AVG^NURARWL8
- DO BEDTOT^NURARWL6
- IF $GET(NUROUT)
- QUIT
- +11 QUIT
- End DoDot:3
- IF $GET(NUROUT)
- QUIT
- DO BRK^NURARWL6
- IF $GET(NUROUT)
- QUIT
- SET NBRK=0
- +12 QUIT
- End DoDot:2
- IF $GET(NUROUT)
- QUIT
- IF NURMDSW
- IF $GET(NWARD)=""
- DO FACTOT^NURARWL9
- +13 QUIT
- End DoDot:1
- IF $GET(NUROUT)
- QUIT
- IF $GET(NURSUMSW)!($GET(NWARD)="")
- DO DAYTL^NURARWL7
- IF $GET(NUROUT)
- QUIT
- IF 'NURMDSW
- SET NBRK=0
- +14 QUIT
- DETAIL ; DETAIL LINE PROCESSING
- +1 SET (NBSEC,X)=0
- FOR
- SET X=$ORDER(^TMP($JOB,NDATE,NPFAC,NPLOC,X))
- IF X=""
- QUIT
- SET NBSEC=NBSEC+1
- +2 SET NADATA=^NURSA(213.4,NDA,1,D1,0)
- SET NJ=$PIECE(NADATA,U)
- IF NJ'>0!('$DATA(^NURSF(213.3,NJ,1)))
- QUIT
- SET NL1=^TMP($JOB,NDATE,NPFAC,NPLOC,NSEC,NSHFT,NDA,D1)
- +3 FOR Z=1:1:5
- SET $PIECE(NPC(NSHFT),U,Z)=0
- +4 SET NPCC(NSHFT)=0
- FOR Z=1,2,3
- SET $PIECE(NREQ(NSHFT),U,Z)=0
- SET $PIECE(NVAR(NSHFT),U,Z)=0
- SET $PIECE(NPROD(NSHFT),U,Z)=$SELECT(NURSZAP'>6:0,1:"")
- +5 ;
- +6 ; DETAIL CALCULATIONS FOR PERCENTAGES-VARIANCES-PERCENT PRODUCTIVITY
- +7 ;
- +8 SET NURS213=^NURSF(213.3,NJ,1)
- SET SECT=$PIECE(NURS213,U)
- SET NPERCEN=0
- FOR X=1:1:5
- SET $PIECE(NPC(NSHFT),U,X)=+$PIECE(NADATA,U,(X+1))
- SET NPCC(NSHFT)=NPCC(NSHFT)+$PIECE(NPC(NSHFT),U,X)
- +9 FOR X="DOM","REC","HEM"
- IF SECT=X
- SET (COUNTSW,COUNTSW(1))=1
- +10 IF +^TMP($JOB,"CEN",NDATE,NPFAC,NPLOC,NSHFT)
- SET NPERCEN=(NPCC(NSHFT)/^TMP($JOB,"CEN",NDATE,NPFAC,NPLOC,NSHFT))
- +11 ;
- +12 ; CALCULATE SHIFT REQUIRED STAFF
- +13 ;
- +14 IF NSHFT=2
- SET NTLFTEE(2)=(($PIECE(NPC(2),U)*$PIECE(NURS213,U,2))+($PIECE(NPC(2),U,2)*$PIECE(NURS213,U,3))+($PIECE(NPC(2),U,3)*$PIECE(NURS213,U,4))+($PIECE(NPC(2),U,4)*$PIECE(NURS213,U,5))+($PIECE(NPC(2),U,5)*$PIECE(NURS213,U,14)))/8.5
- +15 IF NSHFT=3
- SET NTLFTEE(3)=(($PIECE(NPC(3),U)*$PIECE(NURS213,U,6))+($PIECE(NPC(3),U,2)*$PIECE(NURS213,U,7))+($PIECE(NPC(3),U,3)*$PIECE(NURS213,U,8))+($PIECE(NPC(3),U,4)*$PIECE(NURS213,U,9))+($PIECE(NPC(3),U,5)*$PIECE(NURS213,U,15)))/8.5
- +16 IF NSHFT=1
- SET NTLFTEE(1)=(($PIECE(NPC(1),U)*$PIECE(NURS213,U,10))+($PIECE(NPC(1),U,2)*$PIECE(NURS213,U,11))+($PIECE(NPC(1),U,3)*$PIECE(NURS213,U,12))+($PIECE(NPC(1),U,4)*$PIECE(NURS213,U,13))+($PIECE(NPC(1),U,5)*$PIECE(NURS213,U,16)))/8
- +17 ;
- +18 ; GET MANHOURS DATA AND CONVERT TO FTEE
- +19 ;
- +20 SET X=$SELECT($DATA(^NURSA(213.4,NDA,0)):^(0),1:"0^0^0^0")
- SET $PIECE(NFTEE(NSHFT),U)=$SELECT($PIECE(X,U,2):$PIECE(X,U,2)/8,1:0)
- SET $PIECE(NFTEE(NSHFT),U,2)=$SELECT($PIECE(X,U,3):$PIECE(X,U,3)/8,1:0)
- SET $PIECE(NFTEE(NSHFT),U,3)=$SELECT($PIECE(X,U,4):$PIECE(X,U,4)/8,1:0)
- +21 ;
- +22 ; CHECK PROF PERCENTAGE
- +23 ;
- +24 SET Z=NTLFTEE(NSHFT)
- IF $DATA(^NURSF(211.4,NL1,1))
- IF $PIECE(^(1),U,2)
- SET Y=^(1)
- SET NTLFTEE("PROF")=Z/(100/$PIECE(Y,U,2))
- SET NTLFTEE("NPROF")=$SELECT($PIECE(Y,U,2)<100:Z/(100/(100-$PIECE(Y,U,2))),1:0)
- +25 IF '$TEST
- SET Y=^DIC(213.9,1,0)
- SET NTLFTEE("PROF")=Z/(100/$PIECE(Y,U,7))
- SET NTLFTEE("NPROF")=$SELECT($PIECE(Y,U,7)<100:Z/(100/(100-$PIECE(Y,U,7))),1:0)
- +26 SET $PIECE(NREQ(NSHFT),U)=NTLFTEE("PROF")
- SET $PIECE(NREQ(NSHFT),U,2)=(NTLFTEE("NPROF")/2)
- SET $PIECE(NREQ(NSHFT),U,3)=(NTLFTEE("NPROF")/2)
- +27 DO ALLOCATE^NURARWL4
- +28 IF NPCC(NSHFT)
- SET NAVG=NAVG+1
- +29 DO PRINT^NURARWL7
- +30 ;
- +31 ; ACCUMULATE BED SEC TOTALS
- +32 ;
- +33 FOR X=1:1:5
- SET $PIECE(NBPC,U,X)=$PIECE(NBPC,U,X)+$PIECE(NPC(NSHFT),U,X)
- +34 SET NBPCC=NBPCC+NPCC(NSHFT)
- IF COUNTSW
- IF '(SECT="HEM")
- IF '(SECT="REC")
- IF '(SECT="DOM")
- SET COUNTSW=0
- +35 QUIT
