source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURARMH1.m@ 1670

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1NURARMH1 ;HIRMFO/MD,RM,FT-CONTINUATION OF 1106 PATIENT CARE MANHOURS DRIVER PRINT ;3/19/98 13:13
2 ;;4.0;NURSING SERVICE;**9,14**;Apr 25, 1997
3 S U="^" I +$G(NDATED)?7N S Z=+$P(NDATED,U)_" 0" F S Z=$O(^NURSA(213.4,"B",Z)) Q:$E(Z,1,7)'>0!($E(Z,1,7)>+$P(NDATED,U,2)) S NDA=$O(^NURSA(213.4,"B",Z,0)) W:$E(IOST)="C"&'$R(30) "." D Q:NUROUT
4 .S NDATA=$S($D(^NURSA(213.4,NDA,0)):^(0),1:""),(NPWARD,YY(0))=$E($P(NDATA,U),9,99) Q:+NPWARD'>0!($P($G(^NURSF(211.4,+NPWARD,0)),U)="")
5 .I 'NURMDSW S NURFAC(2)=" BLANK"
6 .I NURMDSW S NURFAC(2)=$$EN12^NURSUT3($G(NPWARD)) Q:$G(NURFAC(2))=""
7 .I NURMDSW,$G(NURFAC)=0 Q:$G(NURFAC(1))'=$G(NURFAC(2))
8 .D EN6^NURSAUTL S YY("W")=$S(NPWARD'="":NPWARD,1:" BLANK") I 'NHOSPSW,YY(0)'=NURSWARD Q
9 .S NSHFT=$E(NDATA,8),NTCEN=0
10 .K NBED S D1=0 F S D1=$O(^NURSA(213.4,NDA,1,D1)) Q:D1'>0 S NBED(D1)=$S($D(^NURSA(213.4,NDA,1,D1,0)):^(0),1:""),NCEN=$P(NBED(D1),U,2)+$P(NBED(D1),U,3)+$P(NBED(D1),U,4)+$P(NBED(D1),U,5)+$P(NBED(D1),U,6),NBED(D1)=NCEN_U_NBED(D1),NTCEN=NTCEN+NCEN
11 .I 'NTCEN,'+$P(NDATA,U,2),'+$P(NDATA,U,3),'+$P(NDATA,U,4) Q
12 .I 'NTCEN S:'NBDSECT ^TMP($J,"NURBED",$E(Z,1,7),NURFAC(2)," BLANK",YY("W"),NSHFT)=$P(NDATA,U,2,4) D Q
13 ..I NURMDSW,NHOSPSW,+$G(NURFAC) S:'$D(^TMP("NURBDSM",$J,"MANHOURS/NO BEDSECTION")) ^("MANHOURS/NO BEDSECTION")="" F NZ=1:1:3 S $P(^("MANHOURS/NO BEDSECTION"),U,NZ)=($P(^("MANHOURS/NO BEDSECTION"),U,NZ)+$J($P(NDATA,U,(NZ+1)),0,2))
14 ..Q
15 .F D1=0:0 S D1=$O(NBED(D1)) Q:D1'>0 D
16 ..S YY=$P(NBED(D1),U,2),YY("B")=$S('$D(^NURSF(213.3,YY,0)):" BLANK",$P(^(0),U)'="":$P(^(0),U),1:" BLANK")
17 ..S NCEN=$P(NBED(D1),U),NPERC=NCEN/NTCEN
18 ..I '(YY=NBDSECT!'NBDSECT) Q
19 ..S ^TMP($J,"NURBED",$E(Z,1,7),NURFAC(2),YY("B"),YY("W"),NSHFT)=$J(NPERC*$P(NDATA,U,2),0,2)_U_$J(NPERC*$P(NDATA,U,3),0,2)_U_$J(NPERC*$P(NDATA,U,4),0,2)
20 ..I NURMDSW,NHOSPSW,+NURFAC,YY("B")'="" D
21 ...S:'$D(^TMP("NURBDSM",$J,YY("B"))) ^(YY("B"))="0^0^0"
22 ...F NZ=1:1:3 S $P(^TMP("NURBDSM",$J,YY("B")),U,NZ)=($P(^TMP("NURBDSM",$J,YY("B")),U,NZ)+$J($P(NDATA,U,(NZ+1)),0,2))
23 ...Q
24 ..Q
25 .Q
26 I $D(NDATED) S (ZX,ZY)="" D
27 .I NDATED["MT" S ZX=$E(NDATED,1,5)_"00",ZY=$E(NDATED,1,5)_"31"
28 .I NDATED?3N S ZX=(NDATED-1)_"1000",ZY=NDATED_"0930"
29 .I NDATED["Q" S (ZX,ZY)=+$E(NDATED,1,3),NURZ=$E(NDATED,7) S:NURZ=1 ZX=ZX-1,ZY=ZY-1 S ZX=ZX_$S(NURZ=1:"1000",NURZ=2:"0100",NURZ=3:"0400",1:"0700"),ZY=ZY_$S(NURZ=1:"1231",NURZ=2:"0331",NURZ=3:"0630",1:"0930")
30 .I ZX="" Q
31 .S NURZ=ZX,NURMDSW(3)=1 F S NURZ=$O(^NURSA(213.4,"AB",NURZ)) Q:NURZ=""!(NURZ>ZY) F NDA=0:0 S NDA=$O(^NURSA(213.4,"AB",NURZ,NDA)) Q:NDA'>0 W:$E(IOST)="C"&'$R(30) "." D PERTOT^NURARMH2
32 .Q
33 I '$D(^TMP($J,"NURBED")) S NURFAC(2)=$S($G(NURFAC)=0:$G(NURFAC(1)),1:"") D HEADER W !!,$C(7),"THERE IS NO DATA FOR "_$S($G(NURSWARD(0))'="":NURSWARD(0),1:"THIS REPORT") S NUROUT=1 Q
34 I NURMDSW(3) D PERRPT^NURARMH2 G RUNTL
35 E D REPORT
36RUNTL ;
37 I 'NUROUT,NHOSPSW,NURMDSW,+$G(NURFAC),$O(^TMP("NURBDSM",$J,""))'="" D
38 .D HEADER Q:NUROUT
39 .W !!,?35,"MULTI-DIVISIONAL SUMMARY"
40 .S NBED="" F S NBED=$O(^TMP("NURBDSM",$J,NBED)) Q:NBED="" D
41 ..I $Y>(IOSL-6) D HEADER Q:NUROUT W !!,?35,"MULTI-DIVISIONAL SUMMARY"
42 ..S NDATA=$G(^TMP("NURBDSM",$J,NBED))
43 ..W !!,NBED,?42,$J($P(NDATA,U),7,2),?54,$J($P(NDATA,U,2),7,2),?67,$J($P(NDATA,U,3),7,2)
44 ..Q
45 .Q
46 Q:$G(NURFAC)=0 W !,?40," ------- ------- -------",!,"REPORT TOTAL",?41,$J(FT("RN"),8,2),?53,$J(FT("LPN"),8,2),?66,$J(FT("NA"),8,2)
47 Q
48REPORT U IO D
49 . F HDATE=0:0 S HDATE=$O(^TMP($J,"NURBED",HDATE)) Q:HDATE'>0 D Q:NUROUT D DAYTL Q:NUROUT
50 .. S NURFAC(2)="" F S NURFAC(2)=$O(^TMP($J,"NURBED",HDATE,NURFAC(2))) Q:NURFAC(2)="" D:'$G(NURSUMSW) HEADER Q:NUROUT D Q:NUROUT I NURMDSW,NHOSPSW D FACTL Q:NUROUT
51 ... S YY("B")="" F NF1=0:0 S YY("B")=$O(^TMP($J,"NURBED",HDATE,NURFAC(2),YY("B"))) Q:YY("B")="" W:'$G(NURSUMSW) !,$S(YY("B")'=" BLANK":YY("B"),1:"TOTAL MANHOURS WHEN NO ACUITY DATA IS PRESENT:") D Q:NUROUT D BRK Q:NUROUT
52 .... S YY("W")="" F NF1=0:0 S YY("W")=$O(^TMP($J,"NURBED",HDATE,NURFAC(2),YY("B"),YY("W"))) Q:YY("W")="" D Q:NUROUT
53 ..... S NSHFT="" F NFI=0:0 S NSHFT=$O(^TMP($J,"NURBED",HDATE,NURFAC(2),YY("B"),YY("W"),NSHFT)) Q:NSHFT="" D Q:NUROUT
54 ...... I NURMDSW(1)!($Y>(IOSL-6)) D HEADER Q:NUROUT
55 ...... S TL=^TMP($J,"NURBED",HDATE,NURFAC(2),YY("B"),YY("W"),NSHFT),TL("RN")=$P(TL,U),TL("LPN")=$P(TL,U,2),TL("NA")=$P(TL,U,3)
56 ...... I '$G(NURSUMSW) W !,?6,YY("W"),?35,$S(NSHFT="D":"DAY",NSHFT="E":"EVE",NSHFT="N":"NIGHT",1:""),?43,$J(TL("RN"),6,2),?55,$J(TL("LPN"),6,2),?68,$J(TL("NA"),6,2)
57 ...... S NBRK=1 F X="RN","LPN","NA" S NT(X)=NT(X)+TL(X) S:+$P(NDATED,U)?7N DTL(X)=DTL(X)+TL(X) S FNT(X)=FNT(X)+TL(X),FT(X)=FT(X)+TL(X),(NBCEN,NURMDSW(4))=0
58 ...... Q
59 ..... Q
60 .... Q
61 ... Q
62 .. Q
63 . Q
64 Q
65HEADER ;HEADINGS
66 I 'NURQUEUE,$E(IOST)="C",'NURMDSW(1) D ENDPG^NURSUT1 Q:NUROUT
67 S $P(NURSX,"-",80)="",NURPAGE=NURPAGE+1 S Y=DT D:+Y D^DIQ W:$E(IOST)="C"!(NURPAGE>1) @IOF
68 I NURMDSW,NHOSPSW,$G(NURFAC(2))'="",'$G(NURSUMSW) W ?$$CNTR^NURSUT2(NURFAC(2)),$S($G(NURFAC(2))=" BLANK":"NO FACILITY",1:$G(NURFAC(2)))
69 W !!,Y,?15,$S(NHOSPSW:"Service",1:$E(NURSWARD(0),1,7)),?$X+1,"Manhours "_NURSHDR,?70,"PAGE: ",NURPAGE,!!,?44,"RN",?56,"LPN",?69,"NA",!,NURSX
70 I $G(HDATE)?7N W !,?35," " S Y=HDATE I +Y D DT^DIQ W !,?35,$E(NURSX,1,13)
71 W:'NURMDSW(1) !,$S(YY("B")'=" BLANK":YY("B"),1:"TOTAL MANHOURS WHEN NO ACUITY DATA IS PRESENT:")
72 S NURMDSW(1)=0
73 Q
74BRK ; SUBTOTALS
75 Q:$G(NURSUMSW)
76 W !,?41," ------- ------- -------",!,"SUBTOTAL ",?42,$J(NT("RN"),7,2),?54,$J(NT("LPN"),7,2),?67,$J(NT("NA"),7,2),!
77 F X="RN","LPN","NA" S NT(X)=0
78 Q
79FACTL ; FACILITY TOTALS
80 W !,?41," ------- ------- -------",!,$G(NURFAC(2))," TOTALS ",?42,$J(FNT("RN"),7,2),?54,$J(FNT("LPN"),7,2),?67,$J(FNT("NA"),7,2),!
81 F X="RN","LPN","NA" S FNT(X)=0
82 Q
83DAYTL S Y=HDATE D D^DIQ W !,?41," ------- ------- -------",!,Y_" TOTAL ",?42,$J(DTL("RN"),7,2),?54,$J(DTL("LPN"),7,2),?67,$J(DTL("NA"),7,2),!
84 F X="RN","LPN","NA" S DTL(X)=0
85 Q
Note: See TracBrowser for help on using the repository browser.