- 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
- 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
