PRSNRAS1 ;WOIFO/DAM - POC GROUP ACTIVITY SUMMARY REPORT ;060409
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
;
Q
;
DSPLY(PRSIEN,BEG,END,EXTBEG,EXTEND,STOP) ; gather POC data from 451
;INPUT:
; PRSIEN: Nurse ien 450
; BEG,END: FileMan begin and end dates for report
;
N INDEX,CNT,DAYNODE,FMDT,POCD,WKTOT
N PRSNAME,PRSNTL,SKILMIX,MIX1,MIX2
N PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY
N PPIEN,PRSL,PRSNDAY,STARTDT,STDE,PRSNSSN
D INFO
S FMDT=BEG-.1
S (INDEX,CNT)=0
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)
. K POCD ;array to hold POC data
. D L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
. Q:$G(POCD(0))=0
. D DATA
;
D PRTLOOP(EXTBEG,EXTEND)
Q
;
INFO ;Find nurse information to display in report
;
N PRSNARY
;
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"
Q
;
HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
;
W @IOF
S PG=PG+1
W ?25,"GROUP ACTIVITY SUMMARY REPORT"
W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
W ! ;blank line
W !,"Nurse Name",?21,"Type of",?32,"Type of",?48,"Location",?68,"# of",?75,"T&L"
W !,"Skill Mix",?22,"Time",?33,"Work",?68,"Hours",?75,"Unit"
W !,"--------------------------------------------------------------------------------",!
;
Q
;
DATA ;Extract display data from POCD array
;
N PRSNST,PRSNSP,PRSNPOC,PRSNTT,PRSNWIEN,HOURS,PRSNTIEN
N PRSNTW,PRSNM,PRSNRE,PRSNREC,PRSNRIEN,MEAL,PRSEQ
S (PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY)=""
S PRSNTIEN=0
;
;
S PRSEQ=0
F S PRSEQ=$O(POCD(PRSEQ)) Q:PRSEQ'>0!STOP D
. ;Start Time
. S PRSNST=$P(POCD(PRSEQ),U)
. ;
. ;Stop Time
. S PRSNSP=$P(POCD(PRSEQ),U,2)
. ;
. ;Meal Time
. S MEAL=$P(POCD(PRSEQ),U,3)
. ;
. ;Get hours worked in a given location
. S HOURS=$$AMT^PRSPSAPU(PRSNST,PRSNSP,MEAL)
. ;
. ;Type of Time code IEN
. S PRSNTT=$P(POCD(PRSEQ),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)
. . ;
. S PRSNPOC=$P(POCD(PRSEQ),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(PRSEQ),U,6),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)
.;
.; save hours into work array
. I '$D(WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1)) D
.. S CNT=CNT+1
.. S (INDEX,WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1,0))=CNT
. E D
.. S INDEX=$G(WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1,0))
. S WKTOT(INDEX,PRSNLNG,PRSNTWD,PRSNPOC1)=$G(WKTOT(INDEX,PRSNLNG,PRSNTWD,PRSNPOC1))+HOURS
;
Q
;
PRTLOOP(EXTBEG,EXTEND) ; Loop through Totals array and print each one
;
N PRSEQ,TT,TWD,POC,CNT
S PRSEQ=0,CNT=0
F S PRSEQ=$O(WKTOT(PRSEQ)) Q:PRSEQ'>0!STOP D
. S TT=""
. F S TT=$O(WKTOT(PRSEQ,TT)) Q:TT=""!STOP D
.. S TWD=""
.. F S TWD=$O(WKTOT(PRSEQ,TT,TWD)) Q:TWD=""!STOP D
... S POC=""
... F S POC=$O(WKTOT(PRSEQ,TT,TWD,POC)) Q:POC=""!STOP D
.... S HOURS=$G(WKTOT(PRSEQ,TT,TWD,POC)),CNT=CNT+1
.... D PPP(EXTBEG,EXTEND)
; need a blank line between nurses when there was only one record printed
I CNT=1 W !
Q
;
PPP(EXTBEG,EXTEND) ;
I PRSL W !,$E(PRSNAME,1,19)
W ?21,TT,?32,$E(TWD,1,14),?48,$E(POC,1,16),?66,$J(HOURS,7,2),?75,PRSNTL
W !
I PRSL W " ",$E(SKILMIX,1,17)
;
S PRSL=0
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR(EXTBEG,EXTEND)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRAS1 4101 printed Dec 13, 2024@02:27:17 Page 2
PRSNRAS1 ;WOIFO/DAM - POC GROUP ACTIVITY SUMMARY REPORT ;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 QUIT
+5 ;
DSPLY(PRSIEN,BEG,END,EXTBEG,EXTEND,STOP) ; 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 INDEX,CNT,DAYNODE,FMDT,POCD,WKTOT
+6 NEW PRSNAME,PRSNTL,SKILMIX,MIX1,MIX2
+7 NEW PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY
+8 NEW PPIEN,PRSL,PRSNDAY,STARTDT,STDE,PRSNSSN
+9 DO INFO
+10 SET FMDT=BEG-.1
+11 SET (INDEX,CNT)=0
+12 FOR
SET FMDT=$ORDER(^PRST(458,"AD",FMDT))
if FMDT>END!(FMDT'>0)!STOP
QUIT
Begin DoDot:1
+13 SET DAYNODE=$GET(^PRST(458,"AD",FMDT))
+14 SET PPIEN=+DAYNODE
+15 SET PRSNDAY=$PIECE(DAYNODE,U,2)
+16 ;array to hold POC data
KILL POCD
+17 DO L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
+18 if $GET(POCD(0))=0
QUIT
+19 DO DATA
End DoDot:1
+20 ;
+21 DO PRTLOOP(EXTBEG,EXTEND)
+22 QUIT
+23 ;
INFO ;Find nurse information to display in report
+1 ;
+2 NEW PRSNARY
+3 ;
+4 SET PRSL=1
+5 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
+6 ;Nurse Name
SET PRSNAME=$PIECE(PRSNARY,U)
+7 ;Nurse SSN
SET PRSNSSN=$PIECE(PRSNARY,U,9)
+8 ;Nurse T&L
SET PRSNTL=$PIECE(PRSNARY,U,8)
+9 ; Nurse skillmix
SET SKILMIX=$PIECE($$ISNURSE^PRSNUT01(PRSIEN),U,2)
+10 IF SKILMIX["ADMINISTRATIVE"
SET SKILMIX="ADMIN RN"
+11 QUIT
+12 ;
HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
+4 WRITE ?25,"GROUP ACTIVITY SUMMARY 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 of",?32,"Type of",?48,"Location",?68,"# of",?75,"T&L"
+8 WRITE !,"Skill Mix",?22,"Time",?33,"Work",?68,"Hours",?75,"Unit"
+9 WRITE !,"--------------------------------------------------------------------------------",!
+10 ;
+11 QUIT
+12 ;
DATA ;Extract display data from POCD array
+1 ;
+2 NEW PRSNST,PRSNSP,PRSNPOC,PRSNTT,PRSNWIEN,HOURS,PRSNTIEN
+3 NEW PRSNTW,PRSNM,PRSNRE,PRSNREC,PRSNRIEN,MEAL,PRSEQ
+4 SET (PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY)=""
+5 SET PRSNTIEN=0
+6 ;
+7 ;
+8 SET PRSEQ=0
+9 FOR
SET PRSEQ=$ORDER(POCD(PRSEQ))
if PRSEQ'>0!STOP
QUIT
Begin DoDot:1
+10 ;Start Time
+11 SET PRSNST=$PIECE(POCD(PRSEQ),U)
+12 ;
+13 ;Stop Time
+14 SET PRSNSP=$PIECE(POCD(PRSEQ),U,2)
+15 ;
+16 ;Meal Time
+17 SET MEAL=$PIECE(POCD(PRSEQ),U,3)
+18 ;
+19 ;Get hours worked in a given location
+20 SET HOURS=$$AMT^PRSPSAPU(PRSNST,PRSNSP,MEAL)
+21 ;
+22 ;Type of Time code IEN
+23 SET PRSNTT=$PIECE(POCD(PRSEQ),U,4)
SET PRSNLNG=" "
+24 IF PRSNTT'=""
Begin DoDot:2
+25 ;
+26 ;Type of Time code
+27 SET PRSNTIEN=$ORDER(^PRST(457.3,"B",PRSNTT,0))
+28 if PRSNTIEN=""
QUIT
+29 ;
+30 ;Description for Type of Time code
+31 SET PRSNLNG=$PIECE(^PRST(457.3,PRSNTIEN,0),U,2)
+32 ;
End DoDot:2
+33 SET PRSNPOC=$PIECE(POCD(PRSEQ),U,5)
SET PRSNPOC1=" "
+34 IF PRSNPOC'=""
Begin DoDot:2
+35 ;POC
+36 SET PRSNPOC1=$PIECE($$ISACTIVE^PRSNUT01(DT,PRSNPOC),U,2)
End DoDot:2
+37 ;
+38 ;Type of Work Code IEN
+39 SET PRSNWIEN=$PIECE(POCD(PRSEQ),U,6)
SET PRSNTWD=" "
+40 IF PRSNWIEN'=""
Begin DoDot:2
+41 ;
+42 ;Type of Work Code
+43 SET PRSNTW=$PIECE(^PRSN(451.5,PRSNWIEN,0),U)
+44 ;
+45 ;Description for Type of Work code
+46 SET PRSNTWD=$PIECE(^PRSN(451.5,PRSNWIEN,0),U,2)
End DoDot:2
+47 ;
+48 ; save hours into work array
+49 IF '$DATA(WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1))
Begin DoDot:2
+50 SET CNT=CNT+1
+51 SET (INDEX,WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1,0))=CNT
End DoDot:2
+52 IF '$TEST
Begin DoDot:2
+53 SET INDEX=$GET(WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1,0))
End DoDot:2
+54 SET WKTOT(INDEX,PRSNLNG,PRSNTWD,PRSNPOC1)=$GET(WKTOT(INDEX,PRSNLNG,PRSNTWD,PRSNPOC1))+HOURS
End DoDot:1
+55 ;
+56 QUIT
+57 ;
PRTLOOP(EXTBEG,EXTEND) ; Loop through Totals array and print each one
+1 ;
+2 NEW PRSEQ,TT,TWD,POC,CNT
+3 SET PRSEQ=0
SET CNT=0
+4 FOR
SET PRSEQ=$ORDER(WKTOT(PRSEQ))
if PRSEQ'>0!STOP
QUIT
Begin DoDot:1
+5 SET TT=""
+6 FOR
SET TT=$ORDER(WKTOT(PRSEQ,TT))
if TT=""!STOP
QUIT
Begin DoDot:2
+7 SET TWD=""
+8 FOR
SET TWD=$ORDER(WKTOT(PRSEQ,TT,TWD))
if TWD=""!STOP
QUIT
Begin DoDot:3
+9 SET POC=""
+10 FOR
SET POC=$ORDER(WKTOT(PRSEQ,TT,TWD,POC))
if POC=""!STOP
QUIT
Begin DoDot:4
+11 SET HOURS=$GET(WKTOT(PRSEQ,TT,TWD,POC))
SET CNT=CNT+1
+12 DO PPP(EXTBEG,EXTEND)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 ; need a blank line between nurses when there was only one record printed
+14 IF CNT=1
WRITE !
+15 QUIT
+16 ;
PPP(EXTBEG,EXTEND) ;
+1 IF PRSL
WRITE !,$EXTRACT(PRSNAME,1,19)
+2 WRITE ?21,TT,?32,$EXTRACT(TWD,1,14),?48,$EXTRACT(POC,1,16),?66,$JUSTIFY(HOURS,7,2),?75,PRSNTL
+3 WRITE !
+4 IF PRSL
WRITE " ",$EXTRACT(SKILMIX,1,17)
+5 ;
+6 SET PRSL=0
+7 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR(EXTBEG,EXTEND)
+8 QUIT
