NURARWL4 ;HIRMFO/MD-MANHOURS AMIS 1106a WORK LOAD STATISTICS ;9/20/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),U,1)=1
S (NUROUT,NURMDSW,NURQUEUE)=0 D EN9^NURSAGSP ; Check if facility is multi-divisional.
I '$P($G(^DIC(213.9,1,0)),U,7) D S DIE="^DIC(213.9,",DA=1,DR="8" D ^DIE K DIE,DR G:U[X QUIT
. W !,$C(7),?5,"The professional percentage default field in the NURS PARAMETER File has ",!,?4,"not been completed. Enter a percentage value at the following prompt: ",!
. Q
S NWARD="" D LOSER^NURARST G:$G(NUROUT) QUIT D HSKEEP
D EN11^NURSAGSP G:$G(NUROUT) QUIT
I SEL=1 D EN2 G QUIT:'$D(Y)!(X=U)!($G(NUROUT)) S NWARD=+Y,NWARD(1)=Y(0,0)
I NURMDSW,NWARD="",SEL=2 W ! S DIC(0)="AEMQZ" D EN8^NURSAGSP G:$G(NUROUT) QUIT
EN D EN7^NURSAGP1 G:$G(NUROUT) QUIT D EN1^NURSAUTL G:$G(NUROUT) QUIT
W ! S NURS132=1,ZTRTN="START^NURARWL4" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
START ;
K ^TMP($J) S Z=+NDATED_" 0" F NI=0:0 S Z=$O(^NURSA(213.4,"B",Z)) Q:$E(Z,1,7)>+$P(NDATED,U,2)!(Z="") D ; Sort data by date/facility/location and total unit census.
. S NDA=$O(^NURSA(213.4,"B",Z,0)) I $D(^NURSA(213.4,NDA,0)) I NWARD=$E($P(^(0),U),9,99)!(NWARD="") F D1=0:0 S D1=$O(^NURSA(213.4,NDA,1,D1)) Q:D1'>0 D
.. S NDATA=^NURSA(213.4,NDA,0),NDATA(1)=^NURSA(213.4,NDA,1,D1,0)
.. S Y=$E($P(NDATA,U),8),(NL1,NPWARD)=$E($P(NDATA,U),9,99) S NBED=$S($D(^NURSF(213.3,+NDATA(1),1)):$P(^NURSF(213.3,+NDATA(1),1),U),1:"") I $S('$D(^NURSF(211.4,NL1,0)):1,NBED="":1,1:0) Q
.. D EN6^NURSAUTL Q:NPWARD="" S X=$S(Y="N":1,Y="D":2,Y="E":3,1:0)
.. S:'NURMDSW NURFAC(2)=" BLANK" D
... I $G(NURFAC(2))'=" BLANK" S NURFAC(2)=$$EN12^NURSUT3($G(NL1)) Q:NURFAC(2)="" I $G(NURFAC)=0,$G(NURFAC(1))'=$G(NURFAC(2)) Q
... S ^TMP($J,$E(Z,1,7),NURFAC(2),NPWARD,NBED,X,NDA,D1)=NL1
... S:'$D(^TMP($J,"CEN",$E(Z,1,7),NURFAC(2),NPWARD,X)) ^(X)=0
... S ^TMP($J,"CEN",$E(Z,1,7),NURFAC(2),NPWARD,X)=(^TMP($J,"CEN",$E(Z,1,7),NURFAC(2),NPWARD,X)+$P(NDATA(1),U,2)+$P(NDATA(1),U,3)+$P(NDATA(1),U,4)+$P(NDATA(1),U,5)+$P(NDATA(1),U,6))
... Q
.. Q
. Q
S X=$O(^TMP($J,"")) I X="" S (NDATE,NPCT)=0,NPFAC=$S($G(NURFAC)=0:NURFAC(1),1:"") D HEADER^NURARWL8 W !,"THERE IS NO DATA FOR "_$S($G(NWARD(1))'="":$G(NWARD(1)),1:"THIS REPORT") G QUIT
; Set up report variables
F X=1:1:5 S $P(NPC,U,X)=0,$P(NCPC,U,X)=0,$P(NBPC,U,X)=0,$P(NWPC,U,X)=0,$P(NDPC,U,X)=0,$P(NHPC,U,X)=0,$P(NHCPC,U,X)=0
S (NPCT,NPCC,NCPCC,NBPCC,NHCPCC,NHPCC,NWPCC,NDPCC,NAFTEE,DAFTEE,EAFTEE,NAVG,NBRK)=0,NBR=1
S (COUNTSW,COUNTSW(1),NWPC,NWPCC,NCRQ,NCVAR,NCPROD,NCFT,NHCRQ,NHCFT,NHCVR,NHCPRD,NBREQ,NBVAR,NBPROD,NBFTEE,NWREQ,NWVAR,NWPROD,NWFTEE,NDREQ,NDVAR,NDPROD,NDFTEE,NHREQ,NHVAR,NHPROD,NHFTEE,NAPROD)=0
; Set facility accumulators if appropriate
I NURMDSW S (NFPC,NFPCC,NFREQ,NFVAR,NFPROD,NFFTEE,NFCVR,NFCPRD,NFCFT)=0
F X="DOM","REC","HEM" S (MNHRS(X),DCOUNT(X),DMNHRS(X),COUNT(X))=0 I NURMDSW S (MFHRS(X),FCOUNT(X))=0
U IO D ^NURARWL5 ; Print Module.
D HTOT^NURARWL8
QUIT K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
; KILL LOCAL VARIABLES
Q
HSKEEP ; SET LOCAL VARIABLES
S (NPCT,NSW1)=0
Q
ALLOCATE ;
; ALLOCATE FTEE BASED ON BED SEC CENSUS AND CALCULATE VARIANCE/% PRODUCTIVITY
;
F X=1,2,3 D
.S $P(NDFTEE(NSHFT),U,X)=0,$P(NBREQ,U,X)=$P(NBREQ,U,X)+$J($P(NREQ(NSHFT),U,X),0,1)
.I NBSEC S $P(NDFTEE(NSHFT),U,X)=$S(+NPERCEN&(+NPCC(NSHFT)):($P(NFTEE(NSHFT),U,X)*NPERCEN),+NPCC(NSHFT):$P(NFTEE(NSHFT),U,X),'^TMP($J,"CEN",NDATE,NPFAC,NPLOC,NSHFT):($P(NFTEE(NSHFT),U,X)/NBSEC),1:0)
.S $P(NBFTEE,U,X)=$P(NBFTEE,U,X)+$J($P(NDFTEE(NSHFT),U,X),0,1)
.S $P(NVAR(NSHFT),U,X)=$J($P(NDFTEE(NSHFT),U,X),0,1)-$J($P(NREQ(NSHFT),U,X),0,1)
.I $J($P(NDFTEE(NSHFT),U,X),0,1),$J($P(NREQ(NSHFT),U,X),0,1),NURSZAP'>6,NPCC(NSHFT) S $P(NPROD(NSHFT),U,X)=($J($P(NREQ(NSHFT),U,X),0,1)/$J($P(NDFTEE(NSHFT),U,X),0,1))*100
.Q
Q
EN2 ; ENTRY FROM OPTION NURAPR-RES-AWLOC
W ! S DIC("S")="I '($G(^(""I""))=""A""&($P($G(^(1)),U)=""I""))",DIC("A")="Select Unit: ",DIC="^NURSF(211.4,",DIC(0)="AEMZQ" D ^DIC K DIC I U[X S NUROUT=1 Q
I +Y'>0 G EN2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARWL4 4055 printed Dec 13, 2024@02:19:58 Page 2
NURARWL4 ;HIRMFO/MD-MANHOURS AMIS 1106a WORK LOAD STATISTICS ;9/20/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),U,1)=1
QUIT
+3 ; Check if facility is multi-divisional.
SET (NUROUT,NURMDSW,NURQUEUE)=0
DO EN9^NURSAGSP
+4 IF '$PIECE($GET(^DIC(213.9,1,0)),U,7)
Begin DoDot:1
+5 WRITE !,$CHAR(7),?5,"The professional percentage default field in the NURS PARAMETER File has ",!,?4,"not been completed. Enter a percentage value at the following prompt: ",!
+6 QUIT
End DoDot:1
SET DIE="^DIC(213.9,"
SET DA=1
SET DR="8"
DO ^DIE
KILL DIE,DR
if U[X
GOTO QUIT
+7 SET NWARD=""
DO LOSER^NURARST
if $GET(NUROUT)
GOTO QUIT
DO HSKEEP
+8 DO EN11^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
+9 IF SEL=1
DO EN2
if '$DATA(Y)!(X=U)!($GET(NUROUT))
GOTO QUIT
SET NWARD=+Y
SET NWARD(1)=Y(0,0)
+10 IF NURMDSW
IF NWARD=""
IF SEL=2
WRITE !
SET DIC(0)="AEMQZ"
DO EN8^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
EN DO EN7^NURSAGP1
if $GET(NUROUT)
GOTO QUIT
DO EN1^NURSAUTL
if $GET(NUROUT)
GOTO QUIT
+1 WRITE !
SET NURS132=1
SET ZTRTN="START^NURARWL4"
DO EN7^NURSUT0
if POP!($DATA(ZTSK))
GOTO QUIT
START ;
+1 ; Sort data by date/facility/location and total unit census.
KILL ^TMP($JOB)
SET Z=+NDATED_" 0"
FOR NI=0:0
SET Z=$ORDER(^NURSA(213.4,"B",Z))
if $EXTRACT(Z,1,7)>+$PIECE(NDATED,U,2)!(Z="")
QUIT
Begin DoDot:1
+2 SET NDA=$ORDER(^NURSA(213.4,"B",Z,0))
IF $DATA(^NURSA(213.4,NDA,0))
IF NWARD=$EXTRACT($PIECE(^(0),U),9,99)!(NWARD="")
FOR D1=0:0
SET D1=$ORDER(^NURSA(213.4,NDA,1,D1))
if D1'>0
QUIT
Begin DoDot:2
+3 SET NDATA=^NURSA(213.4,NDA,0)
SET NDATA(1)=^NURSA(213.4,NDA,1,D1,0)
+4 SET Y=$EXTRACT($PIECE(NDATA,U),8)
SET (NL1,NPWARD)=$EXTRACT($PIECE(NDATA,U),9,99)
SET NBED=$SELECT($DATA(^NURSF(213.3,+NDATA(1),1)):$PIECE(^NURSF(213.3,+NDATA(1),1),U),1:"")
IF $SELECT('$DATA(^NURSF(211.4,NL1,0)):1,NBED="":1,1:0)
QUIT
+5 DO EN6^NURSAUTL
if NPWARD=""
QUIT
SET X=$SELECT(Y="N":1,Y="D":2,Y="E":3,1:0)
+6 if 'NURMDSW
SET NURFAC(2)=" BLANK"
Begin DoDot:3
+7 IF $GET(NURFAC(2))'=" BLANK"
SET NURFAC(2)=$$EN12^NURSUT3($GET(NL1))
if NURFAC(2)=""
QUIT
IF $GET(NURFAC)=0
IF $GET(NURFAC(1))'=$GET(NURFAC(2))
QUIT
+8 SET ^TMP($JOB,$EXTRACT(Z,1,7),NURFAC(2),NPWARD,NBED,X,NDA,D1)=NL1
+9 if '$DATA(^TMP($JOB,"CEN",$EXTRACT(Z,1,7),NURFAC(2),NPWARD,X))
SET ^(X)=0
+10 SET ^TMP($JOB,"CEN",$EXTRACT(Z,1,7),NURFAC(2),NPWARD,X)=(^TMP($JOB,"CEN",$EXTRACT(Z,1,7),NURFAC(2),NPWARD,X)+$PIECE(NDATA(1),U,2)+$PIECE(NDATA(1),U,3)+$PIECE(NDATA(1),U,4)+$PIECE(NDATA(1),U,5)+$PIECE(NDATA(1),U,6))
+11 QUIT
End DoDot:3
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 SET X=$ORDER(^TMP($JOB,""))
IF X=""
SET (NDATE,NPCT)=0
SET NPFAC=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
DO HEADER^NURARWL8
WRITE !,"THERE IS NO DATA FOR "_$SELECT($GET(NWARD(1))'="":$GET(NWARD(1)),1:"THIS REPORT")
GOTO QUIT
+15 ; Set up report variables
+16 FOR X=1:1:5
SET $PIECE(NPC,U,X)=0
SET $PIECE(NCPC,U,X)=0
SET $PIECE(NBPC,U,X)=0
SET $PIECE(NWPC,U,X)=0
SET $PIECE(NDPC,U,X)=0
SET $PIECE(NHPC,U,X)=0
SET $PIECE(NHCPC,U,X)=0
+17 SET (NPCT,NPCC,NCPCC,NBPCC,NHCPCC,NHPCC,NWPCC,NDPCC,NAFTEE,DAFTEE,EAFTEE,NAVG,NBRK)=0
SET NBR=1
+18 SET (COUNTSW,COUNTSW(1),NWPC,NWPCC,NCRQ,NCVAR,NCPROD,NCFT,NHCRQ,NHCFT,NHCVR,NHCPRD,NBREQ,NBVAR,NBPROD,NBFTEE,NWREQ,NWVAR,NWPROD,NWFTEE,NDREQ,NDVAR,NDPROD,NDFTEE,NHREQ,NHVAR,NHPROD,NHFTEE,NAPROD)=0
+19 ; Set facility accumulators if appropriate
+20 IF NURMDSW
SET (NFPC,NFPCC,NFREQ,NFVAR,NFPROD,NFFTEE,NFCVR,NFCPRD,NFCFT)=0
+21 FOR X="DOM","REC","HEM"
SET (MNHRS(X),DCOUNT(X),DMNHRS(X),COUNT(X))=0
IF NURMDSW
SET (MFHRS(X),FCOUNT(X))=0
+22 ; Print Module.
USE IO
DO ^NURARWL5
+23 DO HTOT^NURARWL8
QUIT KILL ^TMP($JOB)
DO CLOSE^NURSUT1
DO ^NURAKILL
+1 ; KILL LOCAL VARIABLES
+2 QUIT
HSKEEP ; SET LOCAL VARIABLES
+1 SET (NPCT,NSW1)=0
+2 QUIT
ALLOCATE ;
+1 ; ALLOCATE FTEE BASED ON BED SEC CENSUS AND CALCULATE VARIANCE/% PRODUCTIVITY
+2 ;
+3 FOR X=1,2,3
Begin DoDot:1
+4 SET $PIECE(NDFTEE(NSHFT),U,X)=0
SET $PIECE(NBREQ,U,X)=$PIECE(NBREQ,U,X)+$JUSTIFY($PIECE(NREQ(NSHFT),U,X),0,1)
+5 IF NBSEC
SET $PIECE(NDFTEE(NSHFT),U,X)=$SELECT(+NPERCEN&(+NPCC(NSHFT)):($PIECE(NFTEE(NSHFT),U,X)*NPERCEN),+NPCC(NSHFT):$PIECE(NFTEE(NSHFT),U,X),'^TMP($JOB,"CEN",NDATE,NPFAC,NPLOC,NSHFT):($PIECE(NFTEE(NSHFT),U,X)/NBSEC),1:0)
+6 SET $PIECE(NBFTEE,U,X)=$PIECE(NBFTEE,U,X)+$JUSTIFY($PIECE(NDFTEE(NSHFT),U,X),0,1)
+7 SET $PIECE(NVAR(NSHFT),U,X)=$JUSTIFY($PIECE(NDFTEE(NSHFT),U,X),0,1)-$JUSTIFY($PIECE(NREQ(NSHFT),U,X),0,1)
+8 IF $JUSTIFY($PIECE(NDFTEE(NSHFT),U,X),0,1)
IF $JUSTIFY($PIECE(NREQ(NSHFT),U,X),0,1)
IF NURSZAP'>6
IF NPCC(NSHFT)
SET $PIECE(NPROD(NSHFT),U,X)=($JUSTIFY($PIECE(NREQ(NSHFT),U,X),0,1)/$JUSTIFY($PIECE(NDFTEE(NSHFT),U,X),0,1))*100
+9 QUIT
End DoDot:1
+10 QUIT
EN2 ; ENTRY FROM OPTION NURAPR-RES-AWLOC
+1 WRITE !
SET DIC("S")="I '($G(^(""I""))=""A""&($P($G(^(1)),U)=""I""))"
SET DIC("A")="Select Unit: "
SET DIC="^NURSF(211.4,"
SET DIC(0)="AEMZQ"
DO ^DIC
KILL DIC
IF U[X
SET NUROUT=1
QUIT
+2 IF +Y'>0
GOTO EN2
+3 QUIT
