source: FOIAVistA/tag/r/NURSING_SERVICE-NUR/NURARMH1.m@ 628

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