source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURARWL4.m@ 1397

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