- 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 Mar 13, 2025@21:24:51 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
