- PRSNROLS ;WOIFO/JEO - Overtime summary report ;091611
- ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
- ;;Per VHA Directive 2004-038, this routine should not be modified
- Q
- ;
- DAP ; Entry point for Data Approval Personnel
- N GROUP
- D ACCESS^PRSNUT02(.GROUP,"A",DT,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
- ;
- COORD ;Entry point for VANOD Coordinator
- ; Coordinator has no access limits so let them pick any group
- N GROUP
- D PIKGROUP^PRSNUT04(.GROUP,"",1)
- I $P($G(GROUP(0)),U,2)="E" D Q
- .W !,$P(GROUP(0),U,3)
- D MAIN
- Q
- ;
- MAIN ;
- N RANGE,BEG,END,LASTDT,MTIME,STIME,ETIME,FIELDS,FIRSTDT
- N PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG
- N TODAY,SOTPIM,RTIME,OTTIM,OTARR,MIN,K,GTOT,GGTOT,GGGTOT
- N OTPIM,NURSE,REPLOC
- S TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
- N %ZIS,POP,IOP
- K POCD
- D RANGE
- Q:+RANGE'>0
- S %ZIS="MQ",PG=0
- 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="LOCATION OVERTIME ACTIVITY SUMMARY REPORT"
- . S ZTRTN="START^PRSNROLS"
- . S ZTSAVE("GROUP(")=""
- . S ZTSAVE("BEG")=""
- . S ZTSAVE("END")=""
- . D ^%ZTLOAD
- . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
- E D START
- Q
- ;
- START ;
- N PRSNL,DAYNODE,EXTBEG,EXTEND,FMDT,PPIEN,PRSNAME,PRSNSSN,PRSNTL,NURSE,DIVI,PRSNG
- N PRSNPP,PRSNDAY,PRSNDY,PRSDT,TODAY,PRSNGLB,PICK,STOP,SORT,PG,GHD,PRSNGA,PRSNGB,PRSIEN
- U IO
- K ^TMP($J,"OT")
- D FILE,HDR,PRINT
- D ^%ZISC
- K ^TMP($J,"OT")
- Q
- ;
- RANGE ; User is prompted for a date or date range
- ;
- S RANGE=$$POCRANGE^PRSNUT01()
- S BEG=$P($G(RANGE),U)
- S END=$P($G(RANGE),U,2)
- Q
- ;
- FILE ;
- ;
- S SORT=$P(GROUP(0),U,2),PG=0
- S (PICK,STOP)=0
- S TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
- D INITIAL^PRSNRUT0
- F S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP D
- .S DIVI=$$EXTERNAL^DILFD(456,.01,"",$P(GROUP(PICK),U,3))
- .S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
- .S PRSNGLB=$S($P(PRSNG,U,2)="N":$NA(^NURSF(211.8,"D",$P(PRSNG,U,7))),1:$NA(^PRSPC("ATL"_$P(PRSNG,U,3))))
- .; display and underline group sub header
- .S GHD=$S($P(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_": "_$P(PRSNG,U,3)
- .;S TAB=IOM-$L(GHD)/2-5
- .S PRSNGA=""
- .F S PRSNGA=$O(@PRSNGLB@(PRSNGA)) QUIT:PRSNGA=""!STOP D
- ..S PRSNGB=0
- ..F S PRSNGB=$O(@PRSNGLB@(PRSNGA,PRSNGB)) QUIT:'PRSNGB!STOP D
- ...I $P(PRSNG,U,2)="N",+$P(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB) Q
- ...S PRSIEN=$S($P(PRSNG,U,2)="N":+$G(^VA(200,PRSNGB,450)),1:PRSNGB)
- ...S PRSNL=$$DEFAULTL^PRSNRUT0()
- ...I PRSNL="" S PRSNL="**NONE**"
- ...S NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
- ...I +NURSE D INFO(PRSIEN,DIVI,PICK)
- Q
- ;
- INFO(PRSIEN,DIVI,PICK) ;Find nurse information to display in report
- N FMDT,PPIEN,PRSNDAY,POCD,DAYNODE,NFL
- N PRSNARY,PRSNAME,PRSNSSN,PRSNTL,SKILMIX
- S PRSNARY=$G(^PRSPC(PRSIEN,0))
- 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"
- I SKILMIX["RN" S NFL=1
- I SKILMIX["LPN" S NFL=2
- I SKILMIX'["RN",SKILMIX'["LPN" S NFL=3
- Q:$G(DIVI)=""!($G(PICK)="")
- S STOP=0
- S FMDT=BEG-.1
- F S FMDT=$O(^PRST(458,"AD",FMDT)) Q:FMDT>END!(FMDT'>0)!STOP D
- . S DAYNODE=$G(^PRST(458,"AD",FMDT))
- . S PPIEN=+DAYNODE
- . S PRSNDAY=$P(DAYNODE,U,2)
- . Q:'PRSNDAY
- . K POCD ;array to hold POC data
- . D L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
- . D GETDAY(PRSNDAY,.PRSNDY,.PRSDT),DATA
- Q
- ;
- HDR ;;Display header for report of Individual Nurse Activity
- ;
- W @IOF
- S PG=PG+1
- W ?22,"LOCATION OVERTIME ACTIVITY SUMMARY REPORT"
- W !,"--------------------------------------------------------------------------------"
- W !,EXTBEG_" - "_EXTEND,?42,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
- W ! ;blank line
- W !,"Location",?18,"Reason for",?40,"# Of",?50,"# Of",?60,"# Of",?71,"Total"
- W !,?18,"Overtime",?40,"Hours",?50,"Hours",?60,"Hours",?71,"Hours"
- W !,?41,"RN",?51,"LPN",?61,"UAP"
- W !,"--------------------------------------------------------------------------------",!
- Q
- ;
- DEFAULTL() ;Find external value-nurse's default location
- ;
- Q $P($$PRIMLOC^PRSNUT03($G(^PRSPC(PRSIEN,200))),U,3)
- ;
- GETDAY(PRSNDAY,PRSNDY,PRSDT) ;Find external value of Day Number
- ;
- N PRSDY
- S PRSDY=$P(^PRST(458,PPIEN,2),U,PRSNDAY)
- S PRSNDY=$P(PRSDY," "),PRSDT=$P(PRSDY," ",2,3)
- Q
- ;
- DATA ;Extract display data from POCD array
- ;
- N PRSNST,PRSNSP,PRSNPOC,PRSNPOC1,PRSNTT,PRSNWIEN,PRSNLNG,PRSNTW
- N PRSNM,PRSNRE,PRSNREC,PRSNTWD,PRSNRIEN,PRSNTIEN,PRSL
- N STIME,ETIME,OTTIME
- ;
- S PRSL=0
- F S PRSL=$O(POCD(PRSL)) Q:PRSL'>0!STOP D
- . ;Start and stop time
- . S PRSNST=$P(POCD(PRSL),U),PRSNSP=$P(POCD(PRSL),U,2)
- . ;
- . ;Type of Time code IEN
- . S PRSNTT=$P(POCD(PRSL),U,4),PRSNLNG=" "
- . I PRSNTT'="" D
- . . ;
- . . ;Type of Time code
- . . S PRSNTIEN=$O(^PRST(457.3,"B",PRSNTT,0))
- . . Q:PRSNTIEN'>0
- . . ;
- . . ;Description for Type of Time code
- . . S PRSNLNG=$P(^PRST(457.3,PRSNTIEN,0),U,2)
- . ;
- . S PRSNPOC=$P(POCD(PRSL),U,5),PRSNPOC1="**NONE**"
- . I PRSNPOC'="" D
- . . ;POC
- . . S PRSNPOC1=$P($$ISACTIVE^PRSNUT01(DT,PRSNPOC),U,2)
- . ;
- . ;Type of Work Code IEN
- . S PRSNWIEN=$P(POCD(PRSL),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(POCD(PRSL),U,7)
- . ;no need to continue if this isn't an overtime record
- . Q:$G(PRSNM)=""
- . I PRSNM="V" S PRSNM="V Voluntary"
- . I PRSNM="M" S PRSNM="M Mandatory"
- . ;
- . S PRSNRIEN=$P(POCD(PRSL),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)
- . ;
- . ; OT time
- . S STIME=$P(POCD(PRSL),U,9)
- . S ETIME=$P(POCD(PRSL),U,10)
- . S MTIME=$P(POCD(PRSL),U,3)
- . S OTTIME=$$ELAPSE^PRSPESR2(MTIME,STIME,ETIME)
- . S OTTIME=$P(OTTIME,":",1)*60+$P(OTTIME,":",2) ; IN MIN
- . S ^TMP($J,"OT",PRSNPOC1,PRSNRE,NFL)=$G(^TMP($J,"OT",PRSNPOC1,PRSNRE,NFL))+OTTIME
- ;
- Q
- ;
- PRINT ;Print report
- ;
- S REPLOC="",GGGTOT=0
- F K=1:1:3 S GGTOT(K)=""
- F S REPLOC=$O(^TMP($J,"OT",REPLOC)) Q:REPLOC=""!STOP D
- . F K=1:1:3 S SOTPIM(K)="" ; For a location level
- . S GGTOT=""
- . W ?2,$E(REPLOC,1,14)
- . S OTREASON=""
- . F S OTREASON=$O(^TMP($J,"OT",REPLOC,OTREASON)) Q:OTREASON=""!STOP D
- . . W ?18,OTREASON
- . . S GTOT=""
- . . F K=1:1:3 S OTTIM(K)=""
- . . S (GRANDT,NFL)=""
- . . F S NFL=$O(^TMP($J,"OT",REPLOC,OTREASON,NFL)) Q:NFL="" D
- . . . S OTARR(NFL)=^TMP($J,"OT",REPLOC,OTREASON,NFL)
- . . D GETTIME ; Each occurance
- . . S GTOTPR=$$TIME(GTOT)
- . . F K=1:1:3 S OTTIM(K)=$$TIME(OTTIM(K))
- . . W ?40,$J(OTTIM(1),7),?50,$J(OTTIM(2),7),?60,$J(OTTIM(3),7),?70,$J(GTOTPR,7),!
- . . F K=1:1:3 S OTTIM(K)="",OTARR(K)=""
- . . S GTOTPR=""
- . . I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
- . Q:STOP
- . W !!,?3,"--------------"
- . F K=1:1:3 S SOTPIM(K)=$$TIME(SOTPIM(K))
- . S GGTOT=$$TIME(GGTOT)
- . W !,?10,"TOTAL:" ;Location
- . W ?40,$J(SOTPIM(1),7),?50,$J(SOTPIM(2),7),?60,$J(SOTPIM(3),7),?70,$J(GGTOT,7),!!
- Q:STOP
- S GGGTOT=$$TIME(GGGTOT) F K=1:1:3 S GGTOT(K)=$$TIME(GGTOT(K))
- W !!,?4,"GRAND TOTAL:",?40,$J(GGTOT(1),7),?50,$J(GGTOT(2),7),?60,$J(GGTOT(3),7),?70,$J(GGGTOT,7)
- Q
- ;
- GETTIME ;
- S GTOT=""
- F K=1:1:3 D
- . I $D(OTARR(K)) D
- . . ; Reason
- . . S OTTIM(K)=OTARR(K)
- . . S GTOT=GTOT+OTARR(K)
- . . ; Location
- . . S SOTPIM(K)=SOTPIM(K)+OTARR(K)
- . . S GGTOT=GGTOT+OTARR(K)
- . . ; Total
- . . S GGTOT(K)=GGTOT(K)+OTARR(K)
- . . S GGGTOT=GGGTOT+OTARR(K)
- ;
- Q
- ;
- TIME(TIME) ;
- S HR=TIME\60,MIN=TIME#60
- I MIN<10 S MIN=0_MIN
- Q HR_":"_MIN
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNROLS 8045 printed Feb 18, 2025@23:54:05 Page 2
- PRSNROLS ;WOIFO/JEO - Overtime summary report ;091611
- +1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified
- +3 QUIT
- +4 ;
- DAP ; Entry point for Data Approval Personnel
- +1 NEW GROUP
- +2 DO ACCESS^PRSNUT02(.GROUP,"A",DT,1)
- +3 ; quit if any error during group selection
- +4 IF $PIECE($GET(GROUP(0)),U,2)="E"
- Begin DoDot:1
- +5 WRITE !,$PIECE(GROUP(0),U,3)
- End DoDot:1
- QUIT
- +6 DO MAIN
- +7 QUIT
- +8 ;
- 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,"",1)
- +4 IF $PIECE($GET(GROUP(0)),U,2)="E"
- Begin DoDot:1
- +5 WRITE !,$PIECE(GROUP(0),U,3)
- End DoDot:1
- QUIT
- +6 DO MAIN
- +7 QUIT
- +8 ;
- MAIN ;
- +1 NEW RANGE,BEG,END,LASTDT,MTIME,STIME,ETIME,FIELDS,FIRSTDT
- +2 NEW PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG
- +3 NEW TODAY,SOTPIM,RTIME,OTTIM,OTARR,MIN,K,GTOT,GGTOT,GGGTOT
- +4 NEW OTPIM,NURSE,REPLOC
- +5 SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
- +6 NEW %ZIS,POP,IOP
- +7 KILL POCD
- +8 DO RANGE
- +9 if +RANGE'>0
- QUIT
- +10 SET %ZIS="MQ"
- SET PG=0
- +11 DO ^%ZIS
- +12 if POP
- QUIT
- +13 IF $DATA(IO("Q"))
- Begin DoDot:1
- +14 KILL IO("Q")
- +15 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
- +16 SET ZTDESC="LOCATION OVERTIME ACTIVITY SUMMARY REPORT"
- +17 SET ZTRTN="START^PRSNROLS"
- +18 SET ZTSAVE("GROUP(")=""
- +19 SET ZTSAVE("BEG")=""
- +20 SET ZTSAVE("END")=""
- +21 DO ^%ZTLOAD
- +22 IF $DATA(ZTSK)
- SET ZTREQ="@"
- WRITE !,"Request "_ZTSK_" Queued."
- End DoDot:1
- +23 IF '$TEST
- DO START
- +24 QUIT
- +25 ;
- START ;
- +1 NEW PRSNL,DAYNODE,EXTBEG,EXTEND,FMDT,PPIEN,PRSNAME,PRSNSSN,PRSNTL,NURSE,DIVI,PRSNG
- +2 NEW PRSNPP,PRSNDAY,PRSNDY,PRSDT,TODAY,PRSNGLB,PICK,STOP,SORT,PG,GHD,PRSNGA,PRSNGB,PRSIEN
- +3 USE IO
- +4 KILL ^TMP($JOB,"OT")
- +5 DO FILE
- DO HDR
- DO PRINT
- +6 DO ^%ZISC
- +7 KILL ^TMP($JOB,"OT")
- +8 QUIT
- +9 ;
- RANGE ; User is prompted for a date or date range
- +1 ;
- +2 SET RANGE=$$POCRANGE^PRSNUT01()
- +3 SET BEG=$PIECE($GET(RANGE),U)
- +4 SET END=$PIECE($GET(RANGE),U,2)
- +5 QUIT
- +6 ;
- FILE ;
- +1 ;
- +2 SET SORT=$PIECE(GROUP(0),U,2)
- SET PG=0
- +3 SET (PICK,STOP)=0
- +4 SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
- +5 DO INITIAL^PRSNRUT0
- +6 FOR
- SET PICK=$ORDER(GROUP(PICK))
- if PICK=""!STOP
- QUIT
- Begin DoDot:1
- +7 SET DIVI=$$EXTERNAL^DILFD(456,.01,"",$PIECE(GROUP(PICK),U,3))
- +8 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
- +9 SET PRSNGLB=$SELECT($PIECE(PRSNG,U,2)="N":$NAME(^NURSF(211.8,"D",$PIECE(PRSNG,U,7))),1:$NAME(^PRSPC("ATL"_$PIECE(PRSNG,U,3))))
- +10 ; display and underline group sub header
- +11 SET GHD=$SELECT($PIECE(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_": "_$PIECE(PRSNG,U,3)
- +12 ;S TAB=IOM-$L(GHD)/2-5
- +13 SET PRSNGA=""
- +14 FOR
- SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
- if PRSNGA=""!STOP
- QUIT
- Begin DoDot:2
- +15 SET PRSNGB=0
- +16 FOR
- SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
- if 'PRSNGB!STOP
- QUIT
- Begin DoDot:3
- +17 IF $PIECE(PRSNG,U,2)="N"
- IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
- QUIT
- +18 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
- +19 SET PRSNL=$$DEFAULTL^PRSNRUT0()
- +20 IF PRSNL=""
- SET PRSNL="**NONE**"
- +21 SET NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
- +22 IF +NURSE
- DO INFO(PRSIEN,DIVI,PICK)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 QUIT
- +24 ;
- INFO(PRSIEN,DIVI,PICK) ;Find nurse information to display in report
- +1 NEW FMDT,PPIEN,PRSNDAY,POCD,DAYNODE,NFL
- +2 NEW PRSNARY,PRSNAME,PRSNSSN,PRSNTL,SKILMIX
- +3 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
- +4 ;Nurse T&L
- SET PRSNTL=$PIECE(PRSNARY,U,8)
- +5 ;Nurse skillmix
- SET SKILMIX=$PIECE($$ISNURSE^PRSNUT01(PRSIEN),U,2)
- +6 IF SKILMIX["ADMINISTRATIVE"
- SET SKILMIX="ADMIN RN"
- +7 IF SKILMIX["RN"
- SET NFL=1
- +8 IF SKILMIX["LPN"
- SET NFL=2
- +9 IF SKILMIX'["RN"
- IF SKILMIX'["LPN"
- SET NFL=3
- +10 if $GET(DIVI)=""!($GET(PICK)="")
- QUIT
- +11 SET STOP=0
- +12 SET FMDT=BEG-.1
- +13 FOR
- SET FMDT=$ORDER(^PRST(458,"AD",FMDT))
- if FMDT>END!(FMDT'>0)!STOP
- QUIT
- Begin DoDot:1
- +14 SET DAYNODE=$GET(^PRST(458,"AD",FMDT))
- +15 SET PPIEN=+DAYNODE
- +16 SET PRSNDAY=$PIECE(DAYNODE,U,2)
- +17 if 'PRSNDAY
- QUIT
- +18 ;array to hold POC data
- KILL POCD
- +19 DO L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
- +20 DO GETDAY(PRSNDAY,.PRSNDY,.PRSDT)
- DO DATA
- End DoDot:1
- +21 QUIT
- +22 ;
- HDR ;;Display header for report of Individual Nurse Activity
- +1 ;
- +2 WRITE @IOF
- +3 SET PG=PG+1
- +4 WRITE ?22,"LOCATION OVERTIME ACTIVITY SUMMARY REPORT"
- +5 WRITE !,"--------------------------------------------------------------------------------"
- +6 WRITE !,EXTBEG_" - "_EXTEND,?42,"Run Date: ",TODAY,?70,"Page: ",$JUSTIFY(PG,3)
- +7 ;blank line
- WRITE !
- +8 WRITE !,"Location",?18,"Reason for",?40,"# Of",?50,"# Of",?60,"# Of",?71,"Total"
- +9 WRITE !,?18,"Overtime",?40,"Hours",?50,"Hours",?60,"Hours",?71,"Hours"
- +10 WRITE !,?41,"RN",?51,"LPN",?61,"UAP"
- +11 WRITE !,"--------------------------------------------------------------------------------",!
- +12 QUIT
- +13 ;
- DEFAULTL() ;Find external value-nurse's default location
- +1 ;
- +2 QUIT $PIECE($$PRIMLOC^PRSNUT03($GET(^PRSPC(PRSIEN,200))),U,3)
- +3 ;
- GETDAY(PRSNDAY,PRSNDY,PRSDT) ;Find external value of Day Number
- +1 ;
- +2 NEW PRSDY
- +3 SET PRSDY=$PIECE(^PRST(458,PPIEN,2),U,PRSNDAY)
- +4 SET PRSNDY=$PIECE(PRSDY," ")
- SET PRSDT=$PIECE(PRSDY," ",2,3)
- +5 QUIT
- +6 ;
- DATA ;Extract display data from POCD array
- +1 ;
- +2 NEW PRSNST,PRSNSP,PRSNPOC,PRSNPOC1,PRSNTT,PRSNWIEN,PRSNLNG,PRSNTW
- +3 NEW PRSNM,PRSNRE,PRSNREC,PRSNTWD,PRSNRIEN,PRSNTIEN,PRSL
- +4 NEW STIME,ETIME,OTTIME
- +5 ;
- +6 SET PRSL=0
- +7 FOR
- SET PRSL=$ORDER(POCD(PRSL))
- if PRSL'>0!STOP
- QUIT
- Begin DoDot:1
- +8 ;Start and stop time
- +9 SET PRSNST=$PIECE(POCD(PRSL),U)
- SET PRSNSP=$PIECE(POCD(PRSL),U,2)
- +10 ;
- +11 ;Type of Time code IEN
- +12 SET PRSNTT=$PIECE(POCD(PRSL),U,4)
- SET PRSNLNG=" "
- +13 IF PRSNTT'=""
- Begin DoDot:2
- +14 ;
- +15 ;Type of Time code
- +16 SET PRSNTIEN=$ORDER(^PRST(457.3,"B",PRSNTT,0))
- +17 if PRSNTIEN'>0
- QUIT
- +18 ;
- +19 ;Description for Type of Time code
- +20 SET PRSNLNG=$PIECE(^PRST(457.3,PRSNTIEN,0),U,2)
- End DoDot:2
- +21 ;
- +22 SET PRSNPOC=$PIECE(POCD(PRSL),U,5)
- SET PRSNPOC1="**NONE**"
- +23 IF PRSNPOC'=""
- Begin DoDot:2
- +24 ;POC
- +25 SET PRSNPOC1=$PIECE($$ISACTIVE^PRSNUT01(DT,PRSNPOC),U,2)
- End DoDot:2
- +26 ;
- +27 ;Type of Work Code IEN
- +28 SET PRSNWIEN=$PIECE(POCD(PRSL),U,6)
- SET PRSNTW=" "
- SET PRSNTWD=" "
- +29 IF PRSNWIEN'=""
- Begin DoDot:2
- +30 ;
- +31 ;Type of Work Code
- +32 SET PRSNTW=$PIECE(^PRSN(451.5,PRSNWIEN,0),U)
- +33 ;
- +34 ;Description for Type of Work code
- +35 SET PRSNTWD=$PIECE(^PRSN(451.5,PRSNWIEN,0),U,2)
- End DoDot:2
- +36 ;
- +37 ;OT Mandatory/Voluntary
- +38 SET PRSNM=$PIECE(POCD(PRSL),U,7)
- +39 ;no need to continue if this isn't an overtime record
- +40 if $GET(PRSNM)=""
- QUIT
- +41 IF PRSNM="V"
- SET PRSNM="V Voluntary"
- +42 IF PRSNM="M"
- SET PRSNM="M Mandatory"
- +43 ;
- +44 SET PRSNRIEN=$PIECE(POCD(PRSL),U,8)
- SET PRSNREC=" "
- SET PRSNRE=" "
- +45 IF PRSNRIEN'=""
- Begin DoDot:2
- +46 ;Reason for OT code
- +47 SET PRSNREC=$PIECE(^PRSN(451.6,PRSNRIEN,0),U)
- +48 ;
- +49 ;Description for OT code
- +50 SET PRSNRE=$PIECE(^PRSN(451.6,PRSNRIEN,0),U,2)
- End DoDot:2
- +51 ;
- +52 ; OT time
- +53 SET STIME=$PIECE(POCD(PRSL),U,9)
- +54 SET ETIME=$PIECE(POCD(PRSL),U,10)
- +55 SET MTIME=$PIECE(POCD(PRSL),U,3)
- +56 SET OTTIME=$$ELAPSE^PRSPESR2(MTIME,STIME,ETIME)
- +57 ; IN MIN
- SET OTTIME=$PIECE(OTTIME,":",1)*60+$PIECE(OTTIME,":",2)
- +58 SET ^TMP($JOB,"OT",PRSNPOC1,PRSNRE,NFL)=$GET(^TMP($JOB,"OT",PRSNPOC1,PRSNRE,NFL))+OTTIME
- End DoDot:1
- +59 ;
- +60 QUIT
- +61 ;
- PRINT ;Print report
- +1 ;
- +2 SET REPLOC=""
- SET GGGTOT=0
- +3 FOR K=1:1:3
- SET GGTOT(K)=""
- +4 FOR
- SET REPLOC=$ORDER(^TMP($JOB,"OT",REPLOC))
- if REPLOC=""!STOP
- QUIT
- Begin DoDot:1
- +5 ; For a location level
- FOR K=1:1:3
- SET SOTPIM(K)=""
- +6 SET GGTOT=""
- +7 WRITE ?2,$EXTRACT(REPLOC,1,14)
- +8 SET OTREASON=""
- +9 FOR
- SET OTREASON=$ORDER(^TMP($JOB,"OT",REPLOC,OTREASON))
- if OTREASON=""!STOP
- QUIT
- Begin DoDot:2
- +10 WRITE ?18,OTREASON
- +11 SET GTOT=""
- +12 FOR K=1:1:3
- SET OTTIM(K)=""
- +13 SET (GRANDT,NFL)=""
- +14 FOR
- SET NFL=$ORDER(^TMP($JOB,"OT",REPLOC,OTREASON,NFL))
- if NFL=""
- QUIT
- Begin DoDot:3
- +15 SET OTARR(NFL)=^TMP($JOB,"OT",REPLOC,OTREASON,NFL)
- End DoDot:3
- +16 ; Each occurance
- DO GETTIME
- +17 SET GTOTPR=$$TIME(GTOT)
- +18 FOR K=1:1:3
- SET OTTIM(K)=$$TIME(OTTIM(K))
- +19 WRITE ?40,$JUSTIFY(OTTIM(1),7),?50,$JUSTIFY(OTTIM(2),7),?60,$JUSTIFY(OTTIM(3),7),?70,$JUSTIFY(GTOTPR,7),!
- +20 FOR K=1:1:3
- SET OTTIM(K)=""
- SET OTARR(K)=""
- +21 SET GTOTPR=""
- +22 IF (IOSL-5)<$Y
- SET STOP=$$ASK^PRSLIB00()
- IF 'STOP
- DO HDR
- End DoDot:2
- +23 if STOP
- QUIT
- +24 WRITE !!,?3,"--------------"
- +25 FOR K=1:1:3
- SET SOTPIM(K)=$$TIME(SOTPIM(K))
- +26 SET GGTOT=$$TIME(GGTOT)
- +27 ;Location
- WRITE !,?10,"TOTAL:"
- +28 WRITE ?40,$JUSTIFY(SOTPIM(1),7),?50,$JUSTIFY(SOTPIM(2),7),?60,$JUSTIFY(SOTPIM(3),7),?70,$JUSTIFY(GGTOT,7),!!
- End DoDot:1
- +29 if STOP
- QUIT
- +30 SET GGGTOT=$$TIME(GGGTOT)
- FOR K=1:1:3
- SET GGTOT(K)=$$TIME(GGTOT(K))
- +31 WRITE !!,?4,"GRAND TOTAL:",?40,$JUSTIFY(GGTOT(1),7),?50,$JUSTIFY(GGTOT(2),7),?60,$JUSTIFY(GGTOT(3),7),?70,$JUSTIFY(GGGTOT,7)
- +32 QUIT
- +33 ;
- GETTIME ;
- +1 SET GTOT=""
- +2 FOR K=1:1:3
- Begin DoDot:1
- +3 IF $DATA(OTARR(K))
- Begin DoDot:2
- +4 ; Reason
- +5 SET OTTIM(K)=OTARR(K)
- +6 SET GTOT=GTOT+OTARR(K)
- +7 ; Location
- +8 SET SOTPIM(K)=SOTPIM(K)+OTARR(K)
- +9 SET GGTOT=GGTOT+OTARR(K)
- +10 ; Total
- +11 SET GGTOT(K)=GGTOT(K)+OTARR(K)
- +12 SET GGGTOT=GGGTOT+OTARR(K)
- End DoDot:2
- End DoDot:1
- +13 ;
- +14 QUIT
- +15 ;
- TIME(TIME) ;
- +1 SET HR=TIME\60
- SET MIN=TIME#60
- +2 IF MIN<10
- SET MIN=0_MIN
- +3 QUIT HR_":"_MIN
- +4 ;