- 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 Jan 18, 2025@03:28:37 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