NURARMH2 ;HIRMFO/MD,FT-CONTINUATION OF DRIVER TO PRINT AMIS 1106 MANHOURS REPORTS ;8/9/96 12:40
;;4.0;NURSING SERVICE;;Apr 25, 1997
PERTOT ;TOTAL SUBROUTINE FOR MONTHLY QUARTERLY AND YEARLY MANHOURS TOTALS
K NBED S NDATA=$S($D(^NURSA(213.4,NDA,0)):^(0),1:""),(NPWARD,YY(0))=$E($P(NDATA,U),9,99) Q:$G(^NURSF(211.4,NPWARD,0))="" D EN6^NURSAUTL S YY("W")=$S(NPWARD'="":NPWARD,1:" BLANK"),NTCEN=0 I 'NHOSPSW,YY(0)'=NURSWARD Q
I 'NURMDSW S NURFAC(2)=" BLANK"
I NURMDSW S NURFAC(2)=$$EN12^NURSUT3($G(YY(0))) Q:$G(NURFAC(2))=""
I NURMDSW,$G(NURFAC)=0 Q:$G(NURFAC(1))'=$G(NURFAC(2))
F D1=0:0 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),NBED(D1)=NCEN_U_NBED(D1),NTCEN=NTCEN+NCEN
I 'NTCEN S:'$D(^TMP($J,"NURBED",NURFAC(2)," BLANK",YY("W"))) ^(YY("W"))="0^0^0" S:'$D(^TMP("NURBDSM",$J,"MANHOURS/NO BEDSECTION")) ^("MANHOURS/NO BEDSECTION")="" D
. F NURI=1:1:3 D
. . S $P(^TMP($J,"NURBED",NURFAC(2)," BLANK",YY("W")),U,NURI)=$P(^TMP($J,"NURBED",NURFAC(2)," BLANK",YY("W")),U,NURI)+$J($P(NDATA,U,(NURI+1)),0,2)
. . S $P(^TMP("NURBDSM",$J,"MANHOURS/NO BEDSECTION"),U,NURI)=$P(^TMP("NURBDSM",$J,"MANHOURS/NO BEDSECTION"),U,NURI)+$J($P(NDATA,U,(NURI+1)),0,2)
. . Q
. Q
I NTCEN F D1=0:0 S D1=$O(NBED(D1)) Q:D1'>0 D ADDTOT
Q
ADDTOT ;ACCUMULATE PERIOD TOTAL IN TMP GLOBAL
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")
I '(YY=NBDSECT!'NBDSECT) Q
I '$D(^TMP($J,"NURBED",NURFAC(2),YY("B"),YY("W"))) S ^TMP($J,"NURBED",NURFAC(2),YY("B"),YY("W"))="0^0^0"
S NCEN=$P(NBED(D1),U),NPERC=NCEN/NTCEN
F Y=1:1:3 S $P(^TMP($J,"NURBED",NURFAC(2),YY("B"),YY("W")),U,Y)=$P(^TMP($J,"NURBED",NURFAC(2),YY("B"),YY("W")),U,Y)+$S(Y=1:$J(NPERC*$P(NDATA,U,2),0,2),Y=2:$J(NPERC*$P(NDATA,U,3),0,2),Y=3:$J(NPERC*$P(NDATA,U,4),0,2),1:"")
I NURMDSW,+$G(NURFAC),NHOSPSW,YY("B")'="" D
. S:'$D(^TMP("NURBDSM",$J,YY("B"))) ^(YY("B"))="0^0^0"
. F Z=1:1:3 S $P(^TMP("NURBDSM",$J,YY("B")),U,Z)=($P(^(YY("B")),U,Z)+$J($P(NDATA,U,(Z+1)),0,2))
. Q
Q
PERRPT ;PERIOD REPORT
S NURFAC(2)="" F S NURFAC(2)=$O(^TMP($J,"NURBED",NURFAC(2))) Q:NURFAC(2)="" D:'$G(NURSUMSW) HEADER^NURARMH1 Q:NUROUT D P0 Q:NUROUT I NURMDSW,NHOSPSW D FACTL^NURARMH1 Q:NUROUT
Q
P0 S YY("B")="" F NF1=0:0 S YY("B")=$O(^TMP($J,"NURBED",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 P1 Q:NUROUT I '$G(NURSUMSW) D BRK^NURARMH1
Q
P1 S YY("W")="" F NF1=0:0 S YY("W")=$O(^TMP($J,"NURBED",NURFAC(2),YY("B"),YY("W"))) Q:YY("W")="" D WRITE Q:NUROUT
Q
WRITE ;
I ($Y>(IOSL-6))!(NURMDSW(1)) D HEADER^NURARMH1 Q:NUROUT
S TL=^TMP($J,"NURBED",NURFAC(2),YY("B"),YY("W")),TL("RN")=$P(TL,U),TL("LPN")=$P(TL,U,2),TL("NA")=$P(TL,U,3)
S RNTL=$P(TL,U,1),LPNTL=$P(TL,U,2),NATL=$P(TL,U,3)
I YY("B")=" BLANK",'+TL("RN"),'+TL("LPN"),'+TL("NA") Q
I '$G(NURSUMSW) W !,?6,YY("W"),?42,$J(RNTL,7,2),?54,$J(LPNTL,7,2),?67,$J(NATL,7,2)
S NT("RN")=NT("RN")+RNTL,NT("LPN")=NT("LPN")+LPNTL,NT("NA")=NT("NA")+NATL,FNT("RN")=FNT("RN")+RNTL,FNT("LPN")=FNT("LPN")+LPNTL,FNT("NA")=FNT("NA")+NATL,FT("RN")=FT("RN")+RNTL,FT("LPN")=FT("LPN")+LPNTL,FT("NA")=FT("NA")+NATL,NURMDSW(1)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARMH2 3330 printed Dec 13, 2024@02:19:48 Page 2
NURARMH2 ;HIRMFO/MD,FT-CONTINUATION OF DRIVER TO PRINT AMIS 1106 MANHOURS REPORTS ;8/9/96 12:40
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
PERTOT ;TOTAL SUBROUTINE FOR MONTHLY QUARTERLY AND YEARLY MANHOURS TOTALS
+1 KILL NBED
SET NDATA=$SELECT($DATA(^NURSA(213.4,NDA,0)):^(0),1:"")
SET (NPWARD,YY(0))=$EXTRACT($PIECE(NDATA,U),9,99)
if $GET(^NURSF(211.4,NPWARD,0))=""
QUIT
DO EN6^NURSAUTL
SET YY("W")=$SELECT(NPWARD'="":NPWARD,1:" BLANK")
SET NTCEN=0
IF 'NHOSPSW
IF YY(0)'=NURSWARD
QUIT
+2 IF 'NURMDSW
SET NURFAC(2)=" BLANK"
+3 IF NURMDSW
SET NURFAC(2)=$$EN12^NURSUT3($GET(YY(0)))
if $GET(NURFAC(2))=""
QUIT
+4 IF NURMDSW
IF $GET(NURFAC)=0
if $GET(NURFAC(1))'=$GET(NURFAC(2))
QUIT
+5 FOR D1=0:0
SET D1=$ORDER(^NURSA(213.4,NDA,1,D1))
if D1'>0
QUIT
SET NBED(D1)=$SELECT($DATA(^NURSA(213.4,NDA,1,D1,0)):^(0),1:"")
SET NCEN=$PIECE(NBED(D1),U,2)+$PIECE(NBED(D1),U,3)+$PIECE(NBED(D1),U,4)+$PIECE(NBED(D1),U,5)
SET NBED(D1)=NCEN_U_NBED(D1)
SET NTCEN=NTCEN+NCEN
+6 IF 'NTCEN
if '$DATA(^TMP($JOB,"NURBED",NURFAC(2)," BLANK",YY("W")))
SET ^(YY("W"))="0^0^0"
if '$DATA(^TMP("NURBDSM",$JOB,"MANHOURS/NO BEDSECTION"))
SET ^("MANHOURS/NO BEDSECTION")=""
Begin DoDot:1
+7 FOR NURI=1:1:3
Begin DoDot:2
+8 SET $PIECE(^TMP($JOB,"NURBED",NURFAC(2)," BLANK",YY("W")),U,NURI)=$PIECE(^TMP($JOB,"NURBED",NURFAC(2)," BLANK",YY("W")),U,NURI)+$JUSTIFY($PIECE(NDATA,U,(NURI+1)),0,2)
+9 SET $PIECE(^TMP("NURBDSM",$JOB,"MANHOURS/NO BEDSECTION"),U,NURI)=$PIECE(^TMP("NURBDSM",$JOB,"MANHOURS/NO BEDSECTION"),U,NURI)+$JUSTIFY($PIECE(NDATA,U,(NURI+1)),0,2)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 IF NTCEN
FOR D1=0:0
SET D1=$ORDER(NBED(D1))
if D1'>0
QUIT
DO ADDTOT
+13 QUIT
ADDTOT ;ACCUMULATE PERIOD TOTAL IN TMP GLOBAL
+1 SET YY=$PIECE(NBED(D1),U,2)
SET YY("B")=$SELECT('$DATA(^NURSF(213.3,YY,0)):" BLANK",$PIECE(^(0),U)'="":$PIECE(^(0),U),1:" BLANK")
+2 IF '(YY=NBDSECT!'NBDSECT)
QUIT
+3 IF '$DATA(^TMP($JOB,"NURBED",NURFAC(2),YY("B"),YY("W")))
SET ^TMP($JOB,"NURBED",NURFAC(2),YY("B"),YY("W"))="0^0^0"
+4 SET NCEN=$PIECE(NBED(D1),U)
SET NPERC=NCEN/NTCEN
+5 FOR Y=1:1:3
SET $PIECE(^TMP($JOB,"NURBED",NURFAC(2),YY("B"),YY("W")),U,Y)=$PIECE(^TMP($JOB,"NURBED",NURFAC(2),YY("B"),YY("W")),U,Y)+$SELECT(Y=1:$JUSTIFY(NPERC*$PIECE(NDATA,U,2),0,2),Y=2:$JUSTIFY(NPERC*$PIECE(NDATA,U,3),0,2),Y=3:$JUSTIFY(NPERC*...
... $PIECE(NDATA,U,4),0,2),1:"")
+6 IF NURMDSW
IF +$GET(NURFAC)
IF NHOSPSW
IF YY("B")'=""
Begin DoDot:1
+7 if '$DATA(^TMP("NURBDSM",$JOB,YY("B")))
SET ^(YY("B"))="0^0^0"
+8 FOR Z=1:1:3
SET $PIECE(^TMP("NURBDSM",$JOB,YY("B")),U,Z)=($PIECE(^(YY("B")),U,Z)+$JUSTIFY($PIECE(NDATA,U,(Z+1)),0,2))
+9 QUIT
End DoDot:1
+10 QUIT
PERRPT ;PERIOD REPORT
+1 SET NURFAC(2)=""
FOR
SET NURFAC(2)=$ORDER(^TMP($JOB,"NURBED",NURFAC(2)))
if NURFAC(2)=""
QUIT
if '$GET(NURSUMSW)
DO HEADER^NURARMH1
if NUROUT
QUIT
DO P0
if NUROUT
QUIT
IF NURMDSW
IF NHOSPSW
DO FACTL^NURARMH1
if NUROUT
QUIT
+2 QUIT
P0 SET YY("B")=""
FOR NF1=0:0
SET YY("B")=$ORDER(^TMP($JOB,"NURBED",NURFAC(2),YY("B")))
if YY("B")=""
QUIT
if '$GET(NURSUMSW)
WRITE !,$SELECT(YY("B")'=" BLANK":YY("B"),1:"TOTAL MANHOURS WHEN NO ACUITY DATA IS PRESENT:")
DO P1
if NUROUT
QUIT
IF '$GET(NURSUMSW)
DO BRK^NURARMH1
+1 QUIT
P1 SET YY("W")=""
FOR NF1=0:0
SET YY("W")=$ORDER(^TMP($JOB,"NURBED",NURFAC(2),YY("B"),YY("W")))
if YY("W")=""
QUIT
DO WRITE
if NUROUT
QUIT
+1 QUIT
WRITE ;
+1 IF ($Y>(IOSL-6))!(NURMDSW(1))
DO HEADER^NURARMH1
if NUROUT
QUIT
+2 SET TL=^TMP($JOB,"NURBED",NURFAC(2),YY("B"),YY("W"))
SET TL("RN")=$PIECE(TL,U)
SET TL("LPN")=$PIECE(TL,U,2)
SET TL("NA")=$PIECE(TL,U,3)
+3 SET RNTL=$PIECE(TL,U,1)
SET LPNTL=$PIECE(TL,U,2)
SET NATL=$PIECE(TL,U,3)
+4 IF YY("B")=" BLANK"
IF '+TL("RN")
IF '+TL("LPN")
IF '+TL("NA")
QUIT
+5 IF '$GET(NURSUMSW)
WRITE !,?6,YY("W"),?42,$JUSTIFY(RNTL,7,2),?54,$JUSTIFY(LPNTL,7,2),?67,$JUSTIFY(NATL,7,2)
+6 SET NT("RN")=NT("RN")+RNTL
SET NT("LPN")=NT("LPN")+LPNTL
SET NT("NA")=NT("NA")+NATL
SET FNT("RN")=FNT("RN")+RNTL
SET FNT("LPN")=FNT("LPN")+LPNTL
SET FNT("NA")=FNT("NA")+NATL
SET FT("RN")=FT("RN")+RNTL
SET FT("LPN")=FT("LPN")+LPNTL
SET FT("NA")=FT("NA")+NATL
SET NURMDSW(1)=0
+7 QUIT
