VistA-FOIAVistA/r/NURSING_SERVICE-NUR/NURARMH1.m

86 lines
5.8 KiB
Mathematica

NURARMH1 ;HIRMFO/MD,RM,FT-CONTINUATION OF 1106 PATIENT CARE MANHOURS DRIVER PRINT ;3/19/98 13:13
;;4.0;NURSING SERVICE;**9,14**;Apr 25, 1997
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
.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)="")
.I 'NURMDSW S NURFAC(2)=" BLANK"
.I NURMDSW S NURFAC(2)=$$EN12^NURSUT3($G(NPWARD)) Q:$G(NURFAC(2))=""
.I NURMDSW,$G(NURFAC)=0 Q:$G(NURFAC(1))'=$G(NURFAC(2))
.D EN6^NURSAUTL S YY("W")=$S(NPWARD'="":NPWARD,1:" BLANK") I 'NHOSPSW,YY(0)'=NURSWARD Q
.S NSHFT=$E(NDATA,8),NTCEN=0
.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
.I 'NTCEN,'+$P(NDATA,U,2),'+$P(NDATA,U,3),'+$P(NDATA,U,4) Q
.I 'NTCEN S:'NBDSECT ^TMP($J,"NURBED",$E(Z,1,7),NURFAC(2)," BLANK",YY("W"),NSHFT)=$P(NDATA,U,2,4) D Q
..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))
..Q
.F D1=0:0 S D1=$O(NBED(D1)) Q:D1'>0 D
..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")
..S NCEN=$P(NBED(D1),U),NPERC=NCEN/NTCEN
..I '(YY=NBDSECT!'NBDSECT) Q
..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)
..I NURMDSW,NHOSPSW,+NURFAC,YY("B")'="" D
...S:'$D(^TMP("NURBDSM",$J,YY("B"))) ^(YY("B"))="0^0^0"
...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))
...Q
..Q
.Q
I $D(NDATED) S (ZX,ZY)="" D
.I NDATED["MT" S ZX=$E(NDATED,1,5)_"00",ZY=$E(NDATED,1,5)_"31"
.I NDATED?3N S ZX=(NDATED-1)_"1000",ZY=NDATED_"0930"
.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")
.I ZX="" Q
.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
.Q
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
I NURMDSW(3) D PERRPT^NURARMH2 G RUNTL
E D REPORT
RUNTL ;
I 'NUROUT,NHOSPSW,NURMDSW,+$G(NURFAC),$O(^TMP("NURBDSM",$J,""))'="" D
.D HEADER Q:NUROUT
.W !!,?35,"MULTI-DIVISIONAL SUMMARY"
.S NBED="" F S NBED=$O(^TMP("NURBDSM",$J,NBED)) Q:NBED="" D
..I $Y>(IOSL-6) D HEADER Q:NUROUT W !!,?35,"MULTI-DIVISIONAL SUMMARY"
..S NDATA=$G(^TMP("NURBDSM",$J,NBED))
..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)
..Q
.Q
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)
Q
REPORT U IO D
. F HDATE=0:0 S HDATE=$O(^TMP($J,"NURBED",HDATE)) Q:HDATE'>0 D Q:NUROUT D DAYTL Q:NUROUT
.. 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
... 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
.... 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
..... 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
...... I NURMDSW(1)!($Y>(IOSL-6)) D HEADER Q:NUROUT
...... 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)
...... 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)
...... 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
...... Q
..... Q
.... Q
... Q
.. Q
. Q
Q
HEADER ;HEADINGS
I 'NURQUEUE,$E(IOST)="C",'NURMDSW(1) D ENDPG^NURSUT1 Q:NUROUT
S $P(NURSX,"-",80)="",NURPAGE=NURPAGE+1 S Y=DT D:+Y D^DIQ W:$E(IOST)="C"!(NURPAGE>1) @IOF
I NURMDSW,NHOSPSW,$G(NURFAC(2))'="",'$G(NURSUMSW) W ?$$CNTR^NURSUT2(NURFAC(2)),$S($G(NURFAC(2))=" BLANK":"NO FACILITY",1:$G(NURFAC(2)))
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
I $G(HDATE)?7N W !,?35," " S Y=HDATE I +Y D DT^DIQ W !,?35,$E(NURSX,1,13)
W:'NURMDSW(1) !,$S(YY("B")'=" BLANK":YY("B"),1:"TOTAL MANHOURS WHEN NO ACUITY DATA IS PRESENT:")
S NURMDSW(1)=0
Q
BRK ; SUBTOTALS
Q:$G(NURSUMSW)
W !,?41," ------- ------- -------",!,"SUBTOTAL ",?42,$J(NT("RN"),7,2),?54,$J(NT("LPN"),7,2),?67,$J(NT("NA"),7,2),!
F X="RN","LPN","NA" S NT(X)=0
Q
FACTL ; FACILITY TOTALS
W !,?41," ------- ------- -------",!,$G(NURFAC(2))," TOTALS ",?42,$J(FNT("RN"),7,2),?54,$J(FNT("LPN"),7,2),?67,$J(FNT("NA"),7,2),!
F X="RN","LPN","NA" S FNT(X)=0
Q
DAYTL 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),!
F X="RN","LPN","NA" S DTL(X)=0
Q