PRSNRLOS ;WOIFO/KJS - All Overtime at a Nursing Location - Summary and Detailed;2-2-2012
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
COORD ;Entry point for VANOD Coordinator
; Coordinator has no access limits so let them pick any group
N GROUP
D PIKGROUP^PRSNUT04(.GROUP,"N",1)
; quit if any error during group selection
I $P($G(GROUP(0)),U,2)="E" D Q
.W !,$P(GROUP(0),U,3)
D MAIN
;
Q
;
MAIN ;
N RANGE,BEG,END,EXTBEG,EXTEND,STOP
N DAYBEG,DAYEND
N TYPE,BEG,END
S STOP=0
D TYPE
Q:STOP
D DATE
Q:STOP
D QUE
Q
;
REPORT ;for group of location
;
N PRSIEN,PRSNG,PICK,PG,LOCIEN,PRSNVER,PRSNTS,PRSNDAY,PPIEN,ENDPP,ENDDAY,BEGPP,BEGDAY,TODAY,PG,TIMEREC
N PRSNAME,PRSNSSN,PRSNTL,SKILMIX,PRSL,PRSNDAYS,PRSNDATE
N PRSNST,PRSNSP,PRSNTT,PRSNWIEN,HOURS,PRSNTIEN
N PRSNTW,PRSNTWD,PRSNM,PRSNRE,PRSNREC,PRSNRIEN,MEAL
N PRSNLNG,IEN200,PRIMLOC,PRSNARY,GHD,SKILTYP,TOTHRS,I
K ^TMP($J,"PRSNR")
U IO
S PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
S BEGPP=$G(^PRST(458,"AD",BEG)),BEGDAY=$P(BEGPP,U,2),BEGPP=+BEGPP
S ENDPP=$G(^PRST(458,"AD",END)),ENDDAY=$P(ENDPP,U,2),ENDPP=+ENDPP
S (PICK,STOP)=0
F S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP D
. S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
. S LOCIEN=+GROUP(PICK)
. S PRSIEN=0
. F S PRSIEN=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN)) Q:'PRSIEN!STOP D
.. D INFO
.. S PPIEN=BEGPP-1
.. F S PPIEN=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN)) Q:'PPIEN!STOP!(PPIEN>ENDPP) D
... S PRSNDAYS=$G(^PRST(458,PPIEN,1))
... S PRSNDAY=$S(PPIEN=BEGPP:BEGDAY-1,1:0)
... F S PRSNDAY=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY)) Q:'PRSNDAY!STOP!(PPIEN=ENDPP&(PRSNDAY>ENDDAY)) D
.... S PRSNDATE=$P(PRSNDAYS,U,PRSNDAY),PRSNDATE=$E(PRSNDATE,4,5)_"/"_$E(PRSNDATE,6,7)_"/"_$E(PRSNDATE,2,3)
.... S PRSNVER=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,""),-1)
.... S PRSNTS=0,PRSD=1
.... F S PRSNTS=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,PRSNVER,PRSNTS)) Q:'PRSNTS!STOP D
..... S TIMEREC=$G(^PRSN(451,PPIEN,"E",PRSIEN,"D",PRSNDAY,"V",PRSNVER,"T",PRSNTS,0))
..... D DATA
..... ;NOT overtime so don't proceed
..... Q:PRSNM=""
..... I TYPE="S" D TOTTIM1
..... I TYPE="D" D TOTTIM2
;
I TYPE="S" D HDRSUM1
I TYPE="D" D HDRSUM2
S PICK=""
F S PICK=$O(^TMP($J,"PRSNR",PICK)) Q:PICK=""!STOP D
. S GHD="Location: "_PICK
. S TAB=IOM-$L(GHD)/2-5
. W !!,?TAB,GHD,!
. W ?TAB F I=1:1:$L(GHD) W "-"
. I TYPE="S" D PRTSUM1
. I TYPE="D" D PRTSUM2
;
I STOP G EXIT
I TYPE="S" D
. S HOURS=$G(^TMP($J,"PRSNR")),TOTHRS=0
. F I=1:1:3 S TOTHRS=TOTHRS+$P(HOURS,U,I)
. W !,?2,"GRAND TOTAL:",?43,$J($P(HOURS,U,1),7,2),?53,$J($P(HOURS,U,2),7,2),?63,$J($P(HOURS,U,3),7,2),?73,$J(TOTHRS,7,2)
;
I TYPE="D" D
. S HOURS=$G(^TMP($J,"PRSNR"))
. W !,?2,"GRAND TOTAL:",?66,$J(HOURS,7,2)
;
EXIT ;
W !!,"End of Report"
D ^%ZISC
K ^TMP($J,"PRSNR")
Q
;
INFO ;Find nurse information to display in report
;
S PRSL=1
S PRSNARY=$G(^PRSPC(PRSIEN,0))
S PRSNAME=$P(PRSNARY,U) ;Nurse Name
S PRSNSSN=$P(PRSNARY,U,9) ;Nurse SSN
S PRSNTL=$P(PRSNARY,U,8) ;Nurse T&L
S SKILMIX=$P($$ISNURSE^PRSNUT01(PRSIEN),U,2) ; Nurse skillmix
I SKILMIX["ADMINISTRATIVE" S SKILMIX="ADMIN RN"
S SKILTYP=$S(SKILMIX["RN":1,SKILMIX["LPN":2,1:3)
S IEN200=$G(^PRSPC(PRSIEN,200))
S PRIMLOC=$S(IEN200="":"",1:$$PRIMLOC^PRSNUT03(IEN200))
Q
;
DATA ;Extract display data from POCD array
;
;Start Time
S PRSNST=$P(TIMEREC,U)
;
;Stop Time
S PRSNSP=$P(TIMEREC,U,2)
;
;Meal Time
S MEAL=$P(TIMEREC,U,3)
;
;Get hours worked in a given location
S HOURS=$$AMT^PRSPSAPU(PRSNST,PRSNSP,MEAL)
;
;Type of Time code IEN
S PRSNTT=$P(TIMEREC,U,4),PRSNLNG=" "
I PRSNTT'="" D
. ;
. ;Type of Time code
. S PRSNTIEN=$O(^PRST(457.3,"B",PRSNTT,0))
. Q:PRSNTIEN=""
. ;
. ;Description for Type of Time code
. S PRSNLNG=$P(^PRST(457.3,PRSNTIEN,0),U,2)
. ;
. ;Type of Work Code IEN
S PRSNWIEN=$P(TIMEREC,U,6),PRSNTW=" ",PRSNTWD=" "
I PRSNWIEN'="" D
. ;
. ;Type of Work Code
. S PRSNTW=$P(^PRSN(451.5,PRSNWIEN,0),U)
. ;
. ;Description for Type of Work code
. S PRSNTWD=$P(^PRSN(451.5,PRSNWIEN,0),U,2)
;
;OT Mandatory/Voluntary
S PRSNM=$P(TIMEREC,U,7)
S PRSNRIEN=$P(TIMEREC,U,8),PRSNREC=" ",PRSNRE=" "
I PRSNRIEN'="" D
. ;Reason for OT code
. S PRSNREC=$P(^PRSN(451.6,PRSNRIEN,0),U)
. ;
. ;Description for OT code
. S PRSNRE=$P(^PRSN(451.6,PRSNRIEN,0),U,2)
Q
;
TOTTIM1 ;
; save hours into work array
S $P(^TMP($J,"PRSNR"),U,SKILTYP)=$P($G(^TMP($J,"PRSNR")),U,SKILTYP)+HOURS
S $P(^TMP($J,"PRSNR",PICK),U,SKILTYP)=$P($G(^TMP($J,"PRSNR",PICK)),U,SKILTYP)+HOURS
S $P(^TMP($J,"PRSNR",PICK,3,PRSNTT),U,SKILTYP)=$P($G(^TMP($J,"PRSNR",PICK,3,PRSNTT)),U,SKILTYP)+HOURS
S $P(^TMP($J,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM),U,SKILTYP)=$P($G(^TMP($J,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM)),U,SKILTYP)+HOURS
S $P(^TMP($J,"PRSNR",PICK,1,PRSNRE),U,SKILTYP)=$P($G(^TMP($J,"PRSNR",PICK,1,PRSNRE)),U,SKILTYP)+HOURS
;
Q
;
TOTTIM2 ;
; save hours into work array
S ^TMP($J,"PRSNR")=$G(^TMP($J,"PRSNR"))+HOURS
S ^TMP($J,"PRSNR",PICK)=$G(^TMP($J,"PRSNR",PICK))+HOURS
S ^TMP($J,"PRSNR",PICK,4,PRSNTT)=$G(^TMP($J,"PRSNR",PICK,4,PRSNTT))+HOURS
S ^TMP($J,"PRSNR",PICK,3,PRSNTT_"-"_PRSNM)=$G(^TMP($J,"PRSNR",PICK,3,PRSNTT_"-"_PRSNM))+HOURS
S ^TMP($J,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM_"-"_PRSNREC)=$G(^TMP($J,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM_"-"_PRSNREC))+HOURS
S ^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT_"-"_PRSNM_"-"_PRSNREC_"-"_PRSNTWD)=$G(^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT_"-"_PRSNM_"-"_PRSNREC_"-"_PRSNTWD))+HOURS
;
Q
;
HDRSUM1 ;Display header for report of Individual Nurse Activity
;
W @IOF
S PG=PG+1,PRSL=1
W ?20,"All Overtime at a Nurse Location Summary Report"
W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
W ! ;blank line
W !,?10,"Reason for",?45,"# Of",?55,"# Of",?65,"# Of",?75,"Total"
W !,?10,"Overtime",?45,"Hours",?55,"Hours",?65,"Hours",?75,"Hours"
W !,?46,"RN",?56,"LPN",?66,"UAP"
W !,"--------------------------------------------------------------------------------"
;
Q
;
PRTSUM1 ; Loop through Totals array and print each one
;
N TOTYP
F TOTYP=1:1:3 D Q:STOP
.S PRSNTT=""
.F S PRSNTT=$O(^TMP($J,"PRSNR",PICK,TOTYP,PRSNTT)) Q:PRSNTT=""!STOP D
.. S HOURS=$G(^TMP($J,"PRSNR",PICK,TOTYP,PRSNTT))
.. D PPP1
. W !
Q:STOP
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM1
Q:STOP
S HOURS=$G(^TMP($J,"PRSNR",PICK)),TOTHRS=0
F I=1:1:3 S TOTHRS=TOTHRS+$P(HOURS,U,I)
W !,?4," TOTAL: ",PICK,?43,$J($P(HOURS,U,1),7,2),?53,$J($P(HOURS,U,2),7,2),?63,$J($P(HOURS,U,3),7,2),?73,$J(TOTHRS,7,2),!
Q
;
PPP1 ;
S TOTHRS=0
F I=1:1:3 S TOTHRS=TOTHRS+$P(HOURS,U,I)
W !
I TOTYP=1 W ?10,PRSNTT
I TOTYP'=1 W ?10,"TOTAL: ",PRSNTT
W ?43,$J($P(HOURS,U,1),7,2),?53,$J($P(HOURS,U,2),7,2),?63,$J($P(HOURS,U,3),7,2),?73,$J(TOTHRS,7,2)
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM1
Q
;
HDRSUM2 ;Display header for report of Individual Nurse Activity
;
W @IOF
S PG=PG+1,PRSL=1
W ?20,"All Overtime at a Nurse Location Detail Report"
W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
W ! ;blank line
W !,"Nurse Name",?21,"Type Time-",?32,"Type",?48,"Primary Location",?68,"# of",?75,"T&L"
W !,"Skill Mix",?21,"OT-Reason",?32,"Work",?68,"Hours",?75,"Unit"
W !,"--------------------------------------------------------------------------------"
;
Q
;
PRTSUM2 ; Loop through Totals array and print each one
;
N CNT
S PRSNAME=""
F S PRSNAME=$O(^TMP($J,"PRSNR",PICK,1,PRSNAME)) Q:PRSNAME=""!STOP D
. S PRSIEN=""
. F S PRSIEN=$O(^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN)) Q:PRSIEN=""!STOP D
.. D INFO
.. S PRSNTT="",CNT=0
.. F S PRSNTT=$O(^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT)) Q:PRSNTT=""!STOP D
... S CNT=CNT+1
... S HOURS=$G(^TMP($J,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT))
... D PPP2
..; need a blank line between nurses when there was only one record printed
.. I CNT=1 W !
Q:STOP
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM2
Q:STOP
D PRTSUM3
Q
;
PPP2 ;
I PRSL W !,$E(PRSNAME,1,19)
W ?21,$P(PRSNTT,"-",1,3),?32,$E($P(PRSNTT,"-",4),1,14),?48,$E($P(PRIMLOC,U,3),1,18),?67,$J(HOURS,6,2),?75,PRSNTL,!
I PRSL W " ",$E(SKILMIX,1,17)
;
S PRSL=0
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM2
Q
;
PRTSUM3 ; Loop through Totals array and print each one
;
N TOTYP
F TOTYP=2:1:4 D Q:STOP
.S PRSNTT=""
.F S PRSNTT=$O(^TMP($J,"PRSNR",PICK,TOTYP,PRSNTT)) Q:PRSNTT=""!STOP D
.. S HOURS=$G(^TMP($J,"PRSNR",PICK,TOTYP,PRSNTT))
.. D PPP3
. W !
Q:STOP
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM2
Q:STOP
S HOURS=$G(^TMP($J,"PRSNR",PICK))
W !,?4," TOTAL: ",PICK,?67,$J(HOURS,6,2),!
Q
;
PPP3 ;
W !,?6," TOTAL: ",PRSNTT,?67,$J(HOURS,6,2)
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDRSUM2
Q
;
TYPE ;Choose summary or detailed group activity report
;
N DIR,DIRUT,X,Y
S DIR(0)="S^S:Summary Report;D:Detailed Report"
S DIR("A")="Enter Selection"
S DIR("?")="Enter whether you want to select a Summary or Detailed Overtime Report"
D ^DIR
I $D(DIRUT) S STOP=1 Q
S TYPE=Y
Q
;
DATE ; User is prompted for a date range
;
S RANGE=$$POCRANGE^PRSNUT01()
; QUIT HERE IF RANGE=0
I +$G(RANGE)'>0 S STOP=1
;
S BEG=$P(RANGE,U)
S END=$P(RANGE,U,2)
S EXTBEG=$P(RANGE,U,3)
S EXTEND=$P(RANGE,U,4)
;
Q
;
QUE ;call to generate and display report for individual activity
N %ZIS,POP,IOP
S %ZIS="MQ"
D ^%ZIS
Q:POP
I $D(IO("Q")) D
. K IO("Q")
. N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
. S ZTDESC="All Overtime at a Nurse Location "_$S(TYPE="S":"Summary",1:"Detail")
. S ZTRTN="REPORT^PRSNRLOS"
. S ZTSAVE("GROUP")=""
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("TYPE")=""
. S ZTSAVE("BEG")=""
. S ZTSAVE("END")=""
. S ZTSAVE("EXTBEG")=""
. S ZTSAVE("EXTEND")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" queued."
E D
. D REPORT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRLOS 10251 printed Nov 22, 2024@17:37:30 Page 2
PRSNRLOS ;WOIFO/KJS - All Overtime at a Nursing Location - Summary and Detailed;2-2-2012
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
COORD ;Entry point for VANOD Coordinator
+1 ; Coordinator has no access limits so let them pick any group
+2 NEW GROUP
+3 DO PIKGROUP^PRSNUT04(.GROUP,"N",1)
+4 ; quit if any error during group selection
+5 IF $PIECE($GET(GROUP(0)),U,2)="E"
Begin DoDot:1
+6 WRITE !,$PIECE(GROUP(0),U,3)
End DoDot:1
QUIT
+7 DO MAIN
+8 ;
+9 QUIT
+10 ;
MAIN ;
+1 NEW RANGE,BEG,END,EXTBEG,EXTEND,STOP
+2 NEW DAYBEG,DAYEND
+3 NEW TYPE,BEG,END
+4 SET STOP=0
+5 DO TYPE
+6 if STOP
QUIT
+7 DO DATE
+8 if STOP
QUIT
+9 DO QUE
+10 QUIT
+11 ;
REPORT ;for group of location
+1 ;
+2 NEW PRSIEN,PRSNG,PICK,PG,LOCIEN,PRSNVER,PRSNTS,PRSNDAY,PPIEN,ENDPP,ENDDAY,BEGPP,BEGDAY,TODAY,PG,TIMEREC
+3 NEW PRSNAME,PRSNSSN,PRSNTL,SKILMIX,PRSL,PRSNDAYS,PRSNDATE
+4 NEW PRSNST,PRSNSP,PRSNTT,PRSNWIEN,HOURS,PRSNTIEN
+5 NEW PRSNTW,PRSNTWD,PRSNM,PRSNRE,PRSNREC,PRSNRIEN,MEAL
+6 NEW PRSNLNG,IEN200,PRIMLOC,PRSNARY,GHD,SKILTYP,TOTHRS,I
+7 KILL ^TMP($JOB,"PRSNR")
+8 USE IO
+9 SET PG=0
SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+10 SET BEGPP=$GET(^PRST(458,"AD",BEG))
SET BEGDAY=$PIECE(BEGPP,U,2)
SET BEGPP=+BEGPP
+11 SET ENDPP=$GET(^PRST(458,"AD",END))
SET ENDDAY=$PIECE(ENDPP,U,2)
SET ENDPP=+ENDPP
+12 SET (PICK,STOP)=0
+13 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+14 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
+15 SET LOCIEN=+GROUP(PICK)
+16 SET PRSIEN=0
+17 FOR
SET PRSIEN=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN))
if 'PRSIEN!STOP
QUIT
Begin DoDot:2
+18 DO INFO
+19 SET PPIEN=BEGPP-1
+20 FOR
SET PPIEN=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN))
if 'PPIEN!STOP!(PPIEN>ENDPP)
QUIT
Begin DoDot:3
+21 SET PRSNDAYS=$GET(^PRST(458,PPIEN,1))
+22 SET PRSNDAY=$SELECT(PPIEN=BEGPP:BEGDAY-1,1:0)
+23 FOR
SET PRSNDAY=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY))
if 'PRSNDAY!STOP!(PPIEN=ENDPP&(PRSNDAY>ENDDAY))
QUIT
Begin DoDot:4
+24 SET PRSNDATE=$PIECE(PRSNDAYS,U,PRSNDAY)
SET PRSNDATE=$EXTRACT(PRSNDATE,4,5)_"/"_$EXTRACT(PRSNDATE,6,7)_"/"_$EXTRACT(PRSNDATE,2,3)
+25 SET PRSNVER=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,""),-1)
+26 SET PRSNTS=0
SET PRSD=1
+27 FOR
SET PRSNTS=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,PRSNVER,PRSNTS))
if 'PRSNTS!STOP
QUIT
Begin DoDot:5
+28 SET TIMEREC=$GET(^PRSN(451,PPIEN,"E",PRSIEN,"D",PRSNDAY,"V",PRSNVER,"T",PRSNTS,0))
+29 DO DATA
+30 ;NOT overtime so don't proceed
+31 if PRSNM=""
QUIT
+32 IF TYPE="S"
DO TOTTIM1
+33 IF TYPE="D"
DO TOTTIM2
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
+35 IF TYPE="S"
DO HDRSUM1
+36 IF TYPE="D"
DO HDRSUM2
+37 SET PICK=""
+38 FOR
SET PICK=$ORDER(^TMP($JOB,"PRSNR",PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+39 SET GHD="Location: "_PICK
+40 SET TAB=IOM-$LENGTH(GHD)/2-5
+41 WRITE !!,?TAB,GHD,!
+42 WRITE ?TAB
FOR I=1:1:$LENGTH(GHD)
WRITE "-"
+43 IF TYPE="S"
DO PRTSUM1
+44 IF TYPE="D"
DO PRTSUM2
End DoDot:1
+45 ;
+46 IF STOP
GOTO EXIT
+47 IF TYPE="S"
Begin DoDot:1
+48 SET HOURS=$GET(^TMP($JOB,"PRSNR"))
SET TOTHRS=0
+49 FOR I=1:1:3
SET TOTHRS=TOTHRS+$PIECE(HOURS,U,I)
+50 WRITE !,?2,"GRAND TOTAL:",?43,$JUSTIFY($PIECE(HOURS,U,1),7,2),?53,$JUSTIFY($PIECE(HOURS,U,2),7,2),?63,$JUSTIFY($PIECE(HOURS,U,3),7,2),?73,$JUSTIFY(TOTHRS,7,2)
End DoDot:1
+51 ;
+52 IF TYPE="D"
Begin DoDot:1
+53 SET HOURS=$GET(^TMP($JOB,"PRSNR"))
+54 WRITE !,?2,"GRAND TOTAL:",?66,$JUSTIFY(HOURS,7,2)
End DoDot:1
+55 ;
EXIT ;
+1 WRITE !!,"End of Report"
+2 DO ^%ZISC
+3 KILL ^TMP($JOB,"PRSNR")
+4 QUIT
+5 ;
INFO ;Find nurse information to display in report
+1 ;
+2 SET PRSL=1
+3 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
+4 ;Nurse Name
SET PRSNAME=$PIECE(PRSNARY,U)
+5 ;Nurse SSN
SET PRSNSSN=$PIECE(PRSNARY,U,9)
+6 ;Nurse T&L
SET PRSNTL=$PIECE(PRSNARY,U,8)
+7 ; Nurse skillmix
SET SKILMIX=$PIECE($$ISNURSE^PRSNUT01(PRSIEN),U,2)
+8 IF SKILMIX["ADMINISTRATIVE"
SET SKILMIX="ADMIN RN"
+9 SET SKILTYP=$SELECT(SKILMIX["RN":1,SKILMIX["LPN":2,1:3)
+10 SET IEN200=$GET(^PRSPC(PRSIEN,200))
+11 SET PRIMLOC=$SELECT(IEN200="":"",1:$$PRIMLOC^PRSNUT03(IEN200))
+12 QUIT
+13 ;
DATA ;Extract display data from POCD array
+1 ;
+2 ;Start Time
+3 SET PRSNST=$PIECE(TIMEREC,U)
+4 ;
+5 ;Stop Time
+6 SET PRSNSP=$PIECE(TIMEREC,U,2)
+7 ;
+8 ;Meal Time
+9 SET MEAL=$PIECE(TIMEREC,U,3)
+10 ;
+11 ;Get hours worked in a given location
+12 SET HOURS=$$AMT^PRSPSAPU(PRSNST,PRSNSP,MEAL)
+13 ;
+14 ;Type of Time code IEN
+15 SET PRSNTT=$PIECE(TIMEREC,U,4)
SET PRSNLNG=" "
+16 IF PRSNTT'=""
Begin DoDot:1
+17 ;
+18 ;Type of Time code
+19 SET PRSNTIEN=$ORDER(^PRST(457.3,"B",PRSNTT,0))
+20 if PRSNTIEN=""
QUIT
+21 ;
+22 ;Description for Type of Time code
+23 SET PRSNLNG=$PIECE(^PRST(457.3,PRSNTIEN,0),U,2)
+24 ;
+25 ;Type of Work Code IEN
End DoDot:1
+26 SET PRSNWIEN=$PIECE(TIMEREC,U,6)
SET PRSNTW=" "
SET PRSNTWD=" "
+27 IF PRSNWIEN'=""
Begin DoDot:1
+28 ;
+29 ;Type of Work Code
+30 SET PRSNTW=$PIECE(^PRSN(451.5,PRSNWIEN,0),U)
+31 ;
+32 ;Description for Type of Work code
+33 SET PRSNTWD=$PIECE(^PRSN(451.5,PRSNWIEN,0),U,2)
End DoDot:1
+34 ;
+35 ;OT Mandatory/Voluntary
+36 SET PRSNM=$PIECE(TIMEREC,U,7)
+37 SET PRSNRIEN=$PIECE(TIMEREC,U,8)
SET PRSNREC=" "
SET PRSNRE=" "
+38 IF PRSNRIEN'=""
Begin DoDot:1
+39 ;Reason for OT code
+40 SET PRSNREC=$PIECE(^PRSN(451.6,PRSNRIEN,0),U)
+41 ;
+42 ;Description for OT code
+43 SET PRSNRE=$PIECE(^PRSN(451.6,PRSNRIEN,0),U,2)
End DoDot:1
+44 QUIT
+45 ;
TOTTIM1 ;
+1 ; save hours into work array
+2 SET $PIECE(^TMP($JOB,"PRSNR"),U,SKILTYP)=$PIECE($GET(^TMP($JOB,"PRSNR")),U,SKILTYP)+HOURS
+3 SET $PIECE(^TMP($JOB,"PRSNR",PICK),U,SKILTYP)=$PIECE($GET(^TMP($JOB,"PRSNR",PICK)),U,SKILTYP)+HOURS
+4 SET $PIECE(^TMP($JOB,"PRSNR",PICK,3,PRSNTT),U,SKILTYP)=$PIECE($GET(^TMP($JOB,"PRSNR",PICK,3,PRSNTT)),U,SKILTYP)+HOURS
+5 SET $PIECE(^TMP($JOB,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM),U,SKILTYP)=$PIECE($GET(^TMP($JOB,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM)),U,SKILTYP)+HOURS
+6 SET $PIECE(^TMP($JOB,"PRSNR",PICK,1,PRSNRE),U,SKILTYP)=$PIECE($GET(^TMP($JOB,"PRSNR",PICK,1,PRSNRE)),U,SKILTYP)+HOURS
+7 ;
+8 QUIT
+9 ;
TOTTIM2 ;
+1 ; save hours into work array
+2 SET ^TMP($JOB,"PRSNR")=$GET(^TMP($JOB,"PRSNR"))+HOURS
+3 SET ^TMP($JOB,"PRSNR",PICK)=$GET(^TMP($JOB,"PRSNR",PICK))+HOURS
+4 SET ^TMP($JOB,"PRSNR",PICK,4,PRSNTT)=$GET(^TMP($JOB,"PRSNR",PICK,4,PRSNTT))+HOURS
+5 SET ^TMP($JOB,"PRSNR",PICK,3,PRSNTT_"-"_PRSNM)=$GET(^TMP($JOB,"PRSNR",PICK,3,PRSNTT_"-"_PRSNM))+HOURS
+6 SET ^TMP($JOB,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM_"-"_PRSNREC)=$GET(^TMP($JOB,"PRSNR",PICK,2,PRSNTT_"-"_PRSNM_"-"_PRSNREC))+HOURS
+7 SET ^TMP($JOB,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT_"-"_PRSNM_"-"_PRSNREC_"-"_PRSNTWD)=$GET(^TMP($JOB,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT_"-"_PRSNM_"-"_PRSNREC_"-"_PRSNTWD))+HOURS
+8 ;
+9 QUIT
+10 ;
HDRSUM1 ;Display header for report of Individual Nurse Activity
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
SET PRSL=1
+4 WRITE ?20,"All Overtime at a Nurse Location Summary Report"
+5 WRITE !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$JUSTIFY(PG,3)
+6 ;blank line
WRITE !
+7 WRITE !,?10,"Reason for",?45,"# Of",?55,"# Of",?65,"# Of",?75,"Total"
+8 WRITE !,?10,"Overtime",?45,"Hours",?55,"Hours",?65,"Hours",?75,"Hours"
+9 WRITE !,?46,"RN",?56,"LPN",?66,"UAP"
+10 WRITE !,"--------------------------------------------------------------------------------"
+11 ;
+12 QUIT
+13 ;
PRTSUM1 ; Loop through Totals array and print each one
+1 ;
+2 NEW TOTYP
+3 FOR TOTYP=1:1:3
Begin DoDot:1
+4 SET PRSNTT=""
+5 FOR
SET PRSNTT=$ORDER(^TMP($JOB,"PRSNR",PICK,TOTYP,PRSNTT))
if PRSNTT=""!STOP
QUIT
Begin DoDot:2
+6 SET HOURS=$GET(^TMP($JOB,"PRSNR",PICK,TOTYP,PRSNTT))
+7 DO PPP1
End DoDot:2
+8 WRITE !
End DoDot:1
if STOP
QUIT
+9 if STOP
QUIT
+10 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDRSUM1
+11 if STOP
QUIT
+12 SET HOURS=$GET(^TMP($JOB,"PRSNR",PICK))
SET TOTHRS=0
+13 FOR I=1:1:3
SET TOTHRS=TOTHRS+$PIECE(HOURS,U,I)
+14 WRITE !,?4," TOTAL: ",PICK,?43,$JUSTIFY($PIECE(HOURS,U,1),7,2),?53,$JUSTIFY($PIECE(HOURS,U,2),7,2),?63,$JUSTIFY($PIECE(HOURS,U,3),7,2),?73,$JUSTIFY(TOTHRS,7,2),!
+15 QUIT
+16 ;
PPP1 ;
+1 SET TOTHRS=0
+2 FOR I=1:1:3
SET TOTHRS=TOTHRS+$PIECE(HOURS,U,I)
+3 WRITE !
+4 IF TOTYP=1
WRITE ?10,PRSNTT
+5 IF TOTYP'=1
WRITE ?10,"TOTAL: ",PRSNTT
+6 WRITE ?43,$JUSTIFY($PIECE(HOURS,U,1),7,2),?53,$JUSTIFY($PIECE(HOURS,U,2),7,2),?63,$JUSTIFY($PIECE(HOURS,U,3),7,2),?73,$JUSTIFY(TOTHRS,7,2)
+7 ;
+8 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDRSUM1
+9 QUIT
+10 ;
HDRSUM2 ;Display header for report of Individual Nurse Activity
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
SET PRSL=1
+4 WRITE ?20,"All Overtime at a Nurse Location Detail Report"
+5 WRITE !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$JUSTIFY(PG,3)
+6 ;blank line
WRITE !
+7 WRITE !,"Nurse Name",?21,"Type Time-",?32,"Type",?48,"Primary Location",?68,"# of",?75,"T&L"
+8 WRITE !,"Skill Mix",?21,"OT-Reason",?32,"Work",?68,"Hours",?75,"Unit"
+9 WRITE !,"--------------------------------------------------------------------------------"
+10 ;
+11 QUIT
+12 ;
PRTSUM2 ; Loop through Totals array and print each one
+1 ;
+2 NEW CNT
+3 SET PRSNAME=""
+4 FOR
SET PRSNAME=$ORDER(^TMP($JOB,"PRSNR",PICK,1,PRSNAME))
if PRSNAME=""!STOP
QUIT
Begin DoDot:1
+5 SET PRSIEN=""
+6 FOR
SET PRSIEN=$ORDER(^TMP($JOB,"PRSNR",PICK,1,PRSNAME,PRSIEN))
if PRSIEN=""!STOP
QUIT
Begin DoDot:2
+7 DO INFO
+8 SET PRSNTT=""
SET CNT=0
+9 FOR
SET PRSNTT=$ORDER(^TMP($JOB,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT))
if PRSNTT=""!STOP
QUIT
Begin DoDot:3
+10 SET CNT=CNT+1
+11 SET HOURS=$GET(^TMP($JOB,"PRSNR",PICK,1,PRSNAME,PRSIEN,PRSNTT))
+12 DO PPP2
End DoDot:3
+13 ; need a blank line between nurses when there was only one record printed
+14 IF CNT=1
WRITE !
End DoDot:2
End DoDot:1
+15 if STOP
QUIT
+16 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDRSUM2
+17 if STOP
QUIT
+18 DO PRTSUM3
+19 QUIT
+20 ;
PPP2 ;
+1 IF PRSL
WRITE !,$EXTRACT(PRSNAME,1,19)
+2 WRITE ?21,$PIECE(PRSNTT,"-",1,3),?32,$EXTRACT($PIECE(PRSNTT,"-",4),1,14),?48,$EXTRACT($PIECE(PRIMLOC,U,3),1,18),?67,$JUSTIFY(HOURS,6,2),?75,PRSNTL,!
+3 IF PRSL
WRITE " ",$EXTRACT(SKILMIX,1,17)
+4 ;
+5 SET PRSL=0
+6 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDRSUM2
+7 QUIT
+8 ;
PRTSUM3 ; Loop through Totals array and print each one
+1 ;
+2 NEW TOTYP
+3 FOR TOTYP=2:1:4
Begin DoDot:1
+4 SET PRSNTT=""
+5 FOR
SET PRSNTT=$ORDER(^TMP($JOB,"PRSNR",PICK,TOTYP,PRSNTT))
if PRSNTT=""!STOP
QUIT
Begin DoDot:2
+6 SET HOURS=$GET(^TMP($JOB,"PRSNR",PICK,TOTYP,PRSNTT))
+7 DO PPP3
End DoDot:2
+8 WRITE !
End DoDot:1
if STOP
QUIT
+9 if STOP
QUIT
+10 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDRSUM2
+11 if STOP
QUIT
+12 SET HOURS=$GET(^TMP($JOB,"PRSNR",PICK))
+13 WRITE !,?4," TOTAL: ",PICK,?67,$JUSTIFY(HOURS,6,2),!
+14 QUIT
+15 ;
PPP3 ;
+1 WRITE !,?6," TOTAL: ",PRSNTT,?67,$JUSTIFY(HOURS,6,2)
+2 ;
+3 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDRSUM2
+4 QUIT
+5 ;
TYPE ;Choose summary or detailed group activity report
+1 ;
+2 NEW DIR,DIRUT,X,Y
+3 SET DIR(0)="S^S:Summary Report;D:Detailed Report"
+4 SET DIR("A")="Enter Selection"
+5 SET DIR("?")="Enter whether you want to select a Summary or Detailed Overtime Report"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET STOP=1
QUIT
+8 SET TYPE=Y
+9 QUIT
+10 ;
DATE ; User is prompted for a date range
+1 ;
+2 SET RANGE=$$POCRANGE^PRSNUT01()
+3 ; QUIT HERE IF RANGE=0
+4 IF +$GET(RANGE)'>0
SET STOP=1
+5 ;
+6 SET BEG=$PIECE(RANGE,U)
+7 SET END=$PIECE(RANGE,U,2)
+8 SET EXTBEG=$PIECE(RANGE,U,3)
+9 SET EXTEND=$PIECE(RANGE,U,4)
+10 ;
+11 QUIT
+12 ;
QUE ;call to generate and display report for individual activity
+1 NEW %ZIS,POP,IOP
+2 SET %ZIS="MQ"
+3 DO ^%ZIS
+4 if POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 KILL IO("Q")
+7 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+8 SET ZTDESC="All Overtime at a Nurse Location "_$SELECT(TYPE="S":"Summary",1:"Detail")
+9 SET ZTRTN="REPORT^PRSNRLOS"
+10 SET ZTSAVE("GROUP")=""
+11 SET ZTSAVE("GROUP(")=""
+12 SET ZTSAVE("TYPE")=""
+13 SET ZTSAVE("BEG")=""
+14 SET ZTSAVE("END")=""
+15 SET ZTSAVE("EXTBEG")=""
+16 SET ZTSAVE("EXTEND")=""
+17 DO ^%ZTLOAD
+18 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" queued."
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 DO REPORT
End DoDot:1
+21 QUIT
