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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARWL5 3479 printed Apr 09, 2024@21:21:47 Page 2
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
