PRSNRUT0 ;WOIFO/DAM - Report for POC Data;060409
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
;
;
;
POCDSPLY(PRSIEN,BEG,END) ;Entry point to gather POC data from 451
;INPUT:
; PRSIEN: Nurse ien 450
; BEG,END: FileMan begin and end dates for report
;
N STOP,PRSNL,DAYNODE,EXTBEG,EXTEND,FMDT,PPIEN,PRSNAME,PRSNSSN,PRSNTL
N PRSNPP,PRSNDAY,PRSNDY,PRSDT,PG,TODAY
S STOP=0,PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
D INITIAL
S PRSNL=$$DEFAULTL()
D HDRINFO
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)
. D DATA
Q
;
DEFAULTL() ;Find external value-nurse's default location
;
Q $P($$PRIMLOC^PRSNUT03($G(^PRSPC(PRSIEN,200))),U,3)
;
HDRINFO ;Find nurse information to display in report header
;
N PRSNARY
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
Q
;
HDR ;Display header for report of Individual Nurse Activity
;
W @IOF
S PG=PG+1
W PRSNAME,?32,PRSNL,?48,"T&L"_" "_PRSNTL,?48,?68,$E(PRSNSSN,6,9)
W !,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
W ! ;blank line
W !,"Date",?11,"Tour Time",?27,"Location",?57,"OT Mandatory"
W !,?11,"-Exceptions",?27,"-Work Type",?57,"-OT Reason"
W !,"--------------------------------------------------------------------------------"
;
Q
;
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
;
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),PRSNTIEN=" ",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)
. I PRSNM'="" D
. . 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)
. ;
. D PRNT
;
Q
;
PRNT ;Print report
;
W !
I PRSL=1 W PRSNDY
W ?11,$G(PRSNST)_"-"_$G(PRSNSP),?27,$G(PRSNPOC1),?57,$G(PRSNM)
W !
I PRSL=1 W PRSDT
W ?11,"-"_$G(PRSNTT)_" "_$G(PRSNLNG),?27,"-"_$G(PRSNTW)_" "_$G(PRSNTWD),?57,"-"_$G(PRSNREC)_" "_$G(PRSNRE)
W ! ;blank line
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
Q
;
INITIAL ; Set up external date range
;
N Y
S Y=BEG D DD^%DT S EXTBEG=Y
S Y=END D DD^%DT S EXTEND=Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRUT0 3871 printed Oct 16, 2024@18:28:22 Page 2
PRSNRUT0 ;WOIFO/DAM - Report for POC Data;060409
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 ;
+5 ;
POCDSPLY(PRSIEN,BEG,END) ;Entry point to gather POC data from 451
+1 ;INPUT:
+2 ; PRSIEN: Nurse ien 450
+3 ; BEG,END: FileMan begin and end dates for report
+4 ;
+5 NEW STOP,PRSNL,DAYNODE,EXTBEG,EXTEND,FMDT,PPIEN,PRSNAME,PRSNSSN,PRSNTL
+6 NEW PRSNPP,PRSNDAY,PRSNDY,PRSDT,PG,TODAY
+7 SET STOP=0
SET PG=0
SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+8 DO INITIAL
+9 SET PRSNL=$$DEFAULTL()
+10 DO HDRINFO
+11 DO HDR
+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)
+21 DO DATA
End DoDot:1
+22 QUIT
+23 ;
DEFAULTL() ;Find external value-nurse's default location
+1 ;
+2 QUIT $PIECE($$PRIMLOC^PRSNUT03($GET(^PRSPC(PRSIEN,200))),U,3)
+3 ;
HDRINFO ;Find nurse information to display in report header
+1 ;
+2 NEW PRSNARY
+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 QUIT
+8 ;
HDR ;Display header for report of Individual Nurse Activity
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
+4 WRITE PRSNAME,?32,PRSNL,?48,"T&L"_" "_PRSNTL,?48,?68,$EXTRACT(PRSNSSN,6,9)
+5 WRITE !,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$JUSTIFY(PG,3)
+6 ;blank line
WRITE !
+7 WRITE !,"Date",?11,"Tour Time",?27,"Location",?57,"OT Mandatory"
+8 WRITE !,?11,"-Exceptions",?27,"-Work Type",?57,"-OT Reason"
+9 WRITE !,"--------------------------------------------------------------------------------"
+10 ;
+11 QUIT
+12 ;
GETDAY(PRSNDAY,PRSNDY,PRSDT) ;Find external value of Day Number
+1 ;
+2 NEW PRSDY
+3 ;
+4 SET PRSDY=$PIECE(^PRST(458,PPIEN,2),U,PRSNDAY)
+5 SET PRSNDY=$PIECE(PRSDY," ")
SET PRSDT=$PIECE(PRSDY," ",2,3)
+6 ;
+7 QUIT
+8 ;
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 ;
+5 SET PRSL=0
+6 FOR
SET PRSL=$ORDER(POCD(PRSL))
if PRSL'>0!STOP
QUIT
Begin DoDot:1
+7 ;Start and stop time
+8 SET PRSNST=$PIECE(POCD(PRSL),U)
SET PRSNSP=$PIECE(POCD(PRSL),U,2)
+9 ;
+10 ;Type of Time code IEN
+11 SET PRSNTT=$PIECE(POCD(PRSL),U,4)
SET PRSNTIEN=" "
SET PRSNLNG=" "
+12 IF PRSNTT'=""
Begin DoDot:2
+13 ;
+14 ;Type of Time code
+15 SET PRSNTIEN=$ORDER(^PRST(457.3,"B",PRSNTT,0))
if PRSNTIEN'>0
QUIT
+16 ;
+17 ;Description for Type of Time code
+18 SET PRSNLNG=$PIECE(^PRST(457.3,PRSNTIEN,0),U,2)
+19 ;
End DoDot:2
+20 SET PRSNPOC=$PIECE(POCD(PRSL),U,5)
SET PRSNPOC1=" "
+21 IF PRSNPOC'=""
Begin DoDot:2
+22 ;POC
+23 SET PRSNPOC1=$PIECE($$ISACTIVE^PRSNUT01(DT,PRSNPOC),U,2)
End DoDot:2
+24 ;
+25 ;Type of Work Code IEN
+26 SET PRSNWIEN=$PIECE(POCD(PRSL),U,6)
SET PRSNTW=" "
SET PRSNTWD=" "
+27 IF PRSNWIEN'=""
Begin DoDot:2
+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:2
+34 ;
+35 ;OT Mandatory/Voluntary
+36 SET PRSNM=$PIECE(POCD(PRSL),U,7)
+37 IF PRSNM'=""
Begin DoDot:2
+38 IF PRSNM="V"
SET PRSNM="V Voluntary"
+39 IF PRSNM="M"
SET PRSNM="M Mandatory"
+40 ;
End DoDot:2
+41 SET PRSNRIEN=$PIECE(POCD(PRSL),U,8)
SET PRSNREC=" "
SET PRSNRE=" "
+42 IF PRSNRIEN'=""
Begin DoDot:2
+43 ;Reason for OT code
+44 SET PRSNREC=$PIECE(^PRSN(451.6,PRSNRIEN,0),U)
+45 ;
+46 ;Description for OT code
+47 SET PRSNRE=$PIECE(^PRSN(451.6,PRSNRIEN,0),U,2)
End DoDot:2
+48 ;
+49 DO PRNT
End DoDot:1
+50 ;
+51 QUIT
+52 ;
PRNT ;Print report
+1 ;
+2 WRITE !
+3 IF PRSL=1
WRITE PRSNDY
+4 WRITE ?11,$GET(PRSNST)_"-"_$GET(PRSNSP),?27,$GET(PRSNPOC1),?57,$GET(PRSNM)
+5 WRITE !
+6 IF PRSL=1
WRITE PRSDT
+7 WRITE ?11,"-"_$GET(PRSNTT)_" "_$GET(PRSNLNG),?27,"-"_$GET(PRSNTW)_" "_$GET(PRSNTWD),?57,"-"_$GET(PRSNREC)_" "_$GET(PRSNRE)
+8 ;blank line
WRITE !
+9 ;
+10 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR
+11 QUIT
+12 ;
INITIAL ; Set up external date range
+1 ;
+2 NEW Y
+3 SET Y=BEG
DO DD^%DT
SET EXTBEG=Y
+4 SET Y=END
DO DD^%DT
SET EXTEND=Y
+5 QUIT
