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

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1NURARWL4 ;HIRMFO/MD-MANHOURS AMIS 1106a WORK LOAD STATISTICS ;9/20/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),U,1)=1
4 S (NUROUT,NURMDSW,NURQUEUE)=0 D EN9^NURSAGSP ; Check if facility is multi-divisional.
5 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
6 . 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: ",!
7 . Q
8 S NWARD="" D LOSER^NURARST G:$G(NUROUT) QUIT D HSKEEP
9 D EN11^NURSAGSP G:$G(NUROUT) QUIT
10 I SEL=1 D EN2 G QUIT:'$D(Y)!(X=U)!($G(NUROUT)) S NWARD=+Y,NWARD(1)=Y(0,0)
11 I NURMDSW,NWARD="",SEL=2 W ! S DIC(0)="AEMQZ" D EN8^NURSAGSP G:$G(NUROUT) QUIT
12EN D EN7^NURSAGP1 G:$G(NUROUT) QUIT D EN1^NURSAUTL G:$G(NUROUT) QUIT
13 W ! S NURS132=1,ZTRTN="START^NURARWL4" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
14START ;
15 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.
16 . 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
17 .. S NDATA=^NURSA(213.4,NDA,0),NDATA(1)=^NURSA(213.4,NDA,1,D1,0)
18 .. 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
19 .. D EN6^NURSAUTL Q:NPWARD="" S X=$S(Y="N":1,Y="D":2,Y="E":3,1:0)
20 .. S:'NURMDSW NURFAC(2)=" BLANK" D
21 ... 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
22 ... S ^TMP($J,$E(Z,1,7),NURFAC(2),NPWARD,NBED,X,NDA,D1)=NL1
23 ... S:'$D(^TMP($J,"CEN",$E(Z,1,7),NURFAC(2),NPWARD,X)) ^(X)=0
24 ... 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))
25 ... Q
26 .. Q
27 . Q
28 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
29 ; Set up report variables
30 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
31 S (NPCT,NPCC,NCPCC,NBPCC,NHCPCC,NHPCC,NWPCC,NDPCC,NAFTEE,DAFTEE,EAFTEE,NAVG,NBRK)=0,NBR=1
32 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
33 ; Set facility accumulators if appropriate
34 I NURMDSW S (NFPC,NFPCC,NFREQ,NFVAR,NFPROD,NFFTEE,NFCVR,NFCPRD,NFCFT)=0
35 F X="DOM","REC","HEM" S (MNHRS(X),DCOUNT(X),DMNHRS(X),COUNT(X))=0 I NURMDSW S (MFHRS(X),FCOUNT(X))=0
36 U IO D ^NURARWL5 ; Print Module.
37 D HTOT^NURARWL8
38QUIT K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
39 ; KILL LOCAL VARIABLES
40 Q
41HSKEEP ; SET LOCAL VARIABLES
42 S (NPCT,NSW1)=0
43 Q
44ALLOCATE ;
45 ; ALLOCATE FTEE BASED ON BED SEC CENSUS AND CALCULATE VARIANCE/% PRODUCTIVITY
46 ;
47 F X=1,2,3 D
48 .S $P(NDFTEE(NSHFT),U,X)=0,$P(NBREQ,U,X)=$P(NBREQ,U,X)+$J($P(NREQ(NSHFT),U,X),0,1)
49 .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)
50 .S $P(NBFTEE,U,X)=$P(NBFTEE,U,X)+$J($P(NDFTEE(NSHFT),U,X),0,1)
51 .S $P(NVAR(NSHFT),U,X)=$J($P(NDFTEE(NSHFT),U,X),0,1)-$J($P(NREQ(NSHFT),U,X),0,1)
52 .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
53 .Q
54 Q
55EN2 ; ENTRY FROM OPTION NURAPR-RES-AWLOC
56 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
57 I +Y'>0 G EN2
58 Q
Note: See TracBrowser for help on using the repository browser.