PRSNROLD ;WOIFO/JEO - OVERTIMIVIE DETAIL REPORT ;080811
;;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
N %ZIS,POP,IOP
K POCD
D RANGE
Q:+RANGE'>0
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="LOCATION OVERTIME ACTIVITY DETAIL REPORT"
. S ZTRTN="FILE^PRSNROLD"
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("BEG")=""
. S ZTSAVE("END")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D FILE
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 ;
;
N PRSNL,DAYNODE,EXTBEG,EXTEND,FMDT,PPIEN,PRSNAME,PRSNSSN,PRSNTL
N PRSNPP,PRSNDAY,PRSNDY,PRSDT,TODAY,DIVI,NURSE
N PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG
U IO
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)
;
D ^%ZISC
Q
INFO(PRSIEN,DIVI,PICK) ;Find nurse information to display in report
N FMDT,PPIEN,PRSNDAY,POCD,DAYNODE
N PRSNARY,PRSNAME,PRSNSSN,PRSNTL,SKILMIX
S PRSNARY=$G(^PRSPC(PRSIEN,0))
; Nurse Name
S PRSNAME=$P(PRSNARY,U)
; Nurse SSN
S PRSNSSN=$P(PRSNARY,U,9)
; Nurse T&L
S PRSNTL=$P(PRSNARY,U,8)
; Nurse skillmix
S SKILMIX=$P($$ISNURSE^PRSNUT01(PRSIEN),U,2)
I SKILMIX["ADMINISTRATIVE" S SKILMIX="ADMIN RN"
Q:$G(DIVI)=""!($G(PICK)="")
S STOP=0
I PG>0 S STOP=$$ASK^PRSLIB00()
Q:STOP
D HDR
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 ?19,"NURSE OVERTIME DETAIL REPORT"
W !,PRSNAME,?32,$E(PRSNL,1,14),?48,"T&L"_" "_PRSNTL,?48,?68,$E(PRSNSSN,6,9)
W !,"--------------------------------------------------------------------------------"
W !,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
W ! ;blank line
W !,"Date",?11,"Tour Time",?27,"Location",?46,"# Of",?57,"OT Mandatory"
W !,?11,"-Exceptions",?27,"-Work Type",?45,"Hours",?57,"-OT Reason"
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,PRTDY
;
S PRSL=0,PRTDY=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=" "
. 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)
. D PRNT
Q
PRNT ;Print report
;
W !
I 'PRTDY W PRSNDY
W ?11,$G(PRSNST)_"-"_$G(PRSNSP),?27,$G(PRSNPOC1),?57,$G(PRSNM)
W !
I 'PRTDY W PRSDT
W ?11,"-"_$G(PRSNTT)_" "_$G(PRSNLNG),?27,"-"_$G(PRSNTW)_" "_$G(PRSNTWD),?46,OTTIME,?57,"-"_$G(PRSNREC)_" "_$G(PRSNRE)
W ! ;blank line
S PRTDY=1
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNROLD 6319 printed Nov 22, 2024@17:37:36 Page 2
PRSNROLD ;WOIFO/JEO - OVERTIMIVIE DETAIL REPORT ;080811
+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
MAIN ;
+1 NEW RANGE,BEG,END,LASTDT,MTIME,STIME,ETIME
+2 NEW %ZIS,POP,IOP
+3 KILL POCD
+4 DO RANGE
+5 if +RANGE'>0
QUIT
+6 SET %ZIS="MQ"
+7 DO ^%ZIS
+8 if POP
QUIT
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 KILL IO("Q")
+11 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+12 SET ZTDESC="LOCATION OVERTIME ACTIVITY DETAIL REPORT"
+13 SET ZTRTN="FILE^PRSNROLD"
+14 SET ZTSAVE("GROUP(")=""
+15 SET ZTSAVE("BEG")=""
+16 SET ZTSAVE("END")=""
+17 DO ^%ZTLOAD
+18 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+19 IF '$TEST
DO FILE
+20 QUIT
+21 ;
RANGE ;
+1 ; User is prompted for a date or date range
+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 NEW PRSNL,DAYNODE,EXTBEG,EXTEND,FMDT,PPIEN,PRSNAME,PRSNSSN,PRSNTL
+3 NEW PRSNPP,PRSNDAY,PRSNDY,PRSDT,TODAY,DIVI,NURSE
+4 NEW PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG
+5 USE IO
+6 SET SORT=$PIECE(GROUP(0),U,2)
SET PG=0
+7 SET (PICK,STOP)=0
+8 SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+9 DO INITIAL^PRSNRUT0
+10 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+11 SET DIVI=$$EXTERNAL^DILFD(456,.01,"",$PIECE(GROUP(PICK),U,3))
+12 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
+13 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))))
+14 ; display and underline group sub header
+15 ;
+16 SET GHD=$SELECT($PIECE(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_": "_$PIECE(PRSNG,U,3)
+17 ;S TAB=IOM-$L(GHD)/2-5
+18 SET PRSNGA=""
+19 FOR
SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
if PRSNGA=""!STOP
QUIT
Begin DoDot:2
+20 SET PRSNGB=0
+21 FOR
SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
if 'PRSNGB!STOP
QUIT
Begin DoDot:3
+22 IF $PIECE(PRSNG,U,2)="N"
IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
QUIT
+23 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
+24 SET PRSNL=$$DEFAULTL^PRSNRUT0()
+25 IF PRSNL=""
SET PRSNL="**NONE**"
+26 SET NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
+27 IF +NURSE
DO INFO(PRSIEN,DIVI,PICK)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 DO ^%ZISC
+30 QUIT
INFO(PRSIEN,DIVI,PICK) ;Find nurse information to display in report
+1 NEW FMDT,PPIEN,PRSNDAY,POCD,DAYNODE
+2 NEW PRSNARY,PRSNAME,PRSNSSN,PRSNTL,SKILMIX
+3 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
+4 ; Nurse Name
+5 SET PRSNAME=$PIECE(PRSNARY,U)
+6 ; Nurse SSN
+7 SET PRSNSSN=$PIECE(PRSNARY,U,9)
+8 ; Nurse T&L
+9 SET PRSNTL=$PIECE(PRSNARY,U,8)
+10 ; Nurse skillmix
+11 SET SKILMIX=$PIECE($$ISNURSE^PRSNUT01(PRSIEN),U,2)
+12 IF SKILMIX["ADMINISTRATIVE"
SET SKILMIX="ADMIN RN"
+13 if $GET(DIVI)=""!($GET(PICK)="")
QUIT
+14 SET STOP=0
+15 IF PG>0
SET STOP=$$ASK^PRSLIB00()
+16 if STOP
QUIT
+17 DO HDR
+18 SET FMDT=BEG-.1
+19 FOR
SET FMDT=$ORDER(^PRST(458,"AD",FMDT))
if FMDT>END!(FMDT'>0)!STOP
QUIT
Begin DoDot:1
+20 SET DAYNODE=$GET(^PRST(458,"AD",FMDT))
+21 SET PPIEN=+DAYNODE
+22 SET PRSNDAY=$PIECE(DAYNODE,U,2)
+23 if 'PRSNDAY
QUIT
+24 ;array to hold POC data
KILL POCD
+25 DO L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
+26 DO GETDAY(PRSNDAY,.PRSNDY,.PRSDT)
DO DATA
End DoDot:1
+27 QUIT
+28 ;
HDR ;;Display header for report of Individual Nurse Activity
+1 WRITE @IOF
+2 SET PG=PG+1
+3 WRITE ?19,"NURSE OVERTIME DETAIL REPORT"
+4 WRITE !,PRSNAME,?32,$EXTRACT(PRSNL,1,14),?48,"T&L"_" "_PRSNTL,?48,?68,$EXTRACT(PRSNSSN,6,9)
+5 WRITE !,"--------------------------------------------------------------------------------"
+6 WRITE !,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$JUSTIFY(PG,3)
+7 ;blank line
WRITE !
+8 WRITE !,"Date",?11,"Tour Time",?27,"Location",?46,"# Of",?57,"OT Mandatory"
+9 WRITE !,?11,"-Exceptions",?27,"-Work Type",?45,"Hours",?57,"-OT Reason"
+10 WRITE !,"--------------------------------------------------------------------------------"
+11 QUIT
+12 ;
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,PRTDY
+5 ;
+6 SET PRSL=0
SET PRTDY=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)
+21 ;
End DoDot:2
+22 SET PRSNPOC=$PIECE(POCD(PRSL),U,5)
SET PRSNPOC1=" "
+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 DO PRNT
End DoDot:1
+58 QUIT
PRNT ;Print report
+1 ;
+2 WRITE !
+3 IF 'PRTDY
WRITE PRSNDY
+4 WRITE ?11,$GET(PRSNST)_"-"_$GET(PRSNSP),?27,$GET(PRSNPOC1),?57,$GET(PRSNM)
+5 WRITE !
+6 IF 'PRTDY
WRITE PRSDT
+7 WRITE ?11,"-"_$GET(PRSNTT)_" "_$GET(PRSNLNG),?27,"-"_$GET(PRSNTW)_" "_$GET(PRSNTWD),?46,OTTIME,?57,"-"_$GET(PRSNREC)_" "_$GET(PRSNRE)
+8 ;blank line
WRITE !
+9 SET PRTDY=1
+10 ;
+11 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR
+12 QUIT
+13 ;
