PRSNRDN1 ;WOIFO/KJS - GROUP SUMMARY ACTIVITY DIRECT AND NON DIRECT II REPORT ;080411
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
;
;
;
GATHER(SKILMIX,GRP,PRSIEN,BEG,END) ;Entry point to gather POC data from 451
;INPUT:
; SKILMIX: ARRAY containing totals for various types of work
; subscripted by nurse role (or skill mix)
; GRP: Nurse default location or T&L Unit
; PRSIEN: Nurse ien 450
; BEG,END: FileMan begin and end dates for report
;
N INDEX,CNT,DAYNODE,FMDT,PPIEN,PRSNDAY
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(.SKILMIX,GRP)
;
Q
;
;
DATA(SKILMIX,GRP) ;Extract data from POCD array
;
N PRSL,ST,SP,MEAL,HOURS,TT,TIEN,POC,POC1,WIEN,TW,TWD,TYPETM,TYPEWK
;
S PRSL=0
F S PRSL=$O(POCD(PRSL)) Q:PRSL'>0 D
.;
.;Start and stop time and mealtime
.S ST=$P(POCD(PRSL),U),SP=$P(POCD(PRSL),U,2),MEAL=$P(POCD(PRSL),U,3)
.;
.;Get elapsed time
.S HOURS=$$AMT^PRSPSAPU(ST,SP,MEAL)
.;
.;Type of Time code IEN
.S (TIEN,TYPETM)=""
.S TT=$P(POCD(PRSL),U,4)
.I TT'="" D
..;
..;Type of Time code
..S TIEN=$O(^PRST(457.3,"B",TT,TIEN))
..Q:TIEN=""
..;
..;Description for Type of Time code
..S TYPETM=$P(^PRST(457.3,TIEN,0),U,2) ;eg, Direct Care, AL
..;
.S POC1=""
.S POC=$P(POCD(PRSL),U,5)
.I POC'="" D
..S POC1=$P($$ISACTIVE^PRSNUT01(DT,POC),U,2) ;Location
.;
.;Type of Work Code IEN
.S (TW,TWD)=""
.S WIEN=$P(POCD(PRSL),U,6)
.I WIEN'="" D
..;
..;Type of Work Code
..S TW=$P(^PRSN(451.5,WIEN,0),U)
..;
..;Description for Type of Work code
..S TWD=$P(^PRSN(451.5,WIEN,0),U,2)
.
.; save skill mix, hours and type of work into SKILMIX array
.Q:(TYPETM="")!(POC1="")
.;
.S TYPEWK=$S(TW="DC":"Direct",1:"Non Direct")
.S SKILMIX(GRP,TYPETM,TYPEWK)=$G(SKILMIX(GRP,TYPETM,TYPEWK))+HOURS
Q
HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
;
W @IOF
S PG=PG+1,PRTGP=1
W ?17,"GROUP SUMMARY ACTIVITY DIRECT AND NON DIRECT REPORT"
W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
W ! ;blank line
W !,"Location",?22,"Type of Time",?44,"Type of Work",?75,"Hours"
W !,"--------------------------------------------------------------------------------"
;
Q
PRTLP(EXTBEG,EXTEND) ;Order through SKILMIX array, total data & display
N RNDC,LNDC,UNDC,GP,TNDC,TYPEWK,TYPETM
S GP=0
F S GP=$O(SKILMIX(GP)) Q:GP=""!STOP D
.S TYPETM="",PRTGP=1
.F S TYPETM=$O(SKILMIX(GP,TYPETM)) Q:TYPETM=""!STOP D
..S (RNDC,LNDC,UNDC,TNDC)=0
..S TYPEWK=""
..F S TYPEWK=$O(SKILMIX(GP,TYPETM,TYPEWK)) Q:TYPEWK=""!STOP D
...S TOTHRS=$P(SKILMIX(GP,TYPETM,TYPEWK),U)
...D PPP(.STOP,EXTBEG,EXTEND)
Q
PPP(STOP,EXTBEG,EXTEND) ;
I PRTGP W !,GP S PRTGP=0
W ?22,TYPETM,?44,TYPEWK,?72,$J(TOTHRS,8,2),!
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR(EXTBEG,EXTEND)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRDN1 3190 printed Sep 23, 2025@20:03:43 Page 2
PRSNRDN1 ;WOIFO/KJS - GROUP SUMMARY ACTIVITY DIRECT AND NON DIRECT II REPORT ;080411
+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 ;
GATHER(SKILMIX,GRP,PRSIEN,BEG,END) ;Entry point to gather POC data from 451
+1 ;INPUT:
+2 ; SKILMIX: ARRAY containing totals for various types of work
+3 ; subscripted by nurse role (or skill mix)
+4 ; GRP: Nurse default location or T&L Unit
+5 ; PRSIEN: Nurse ien 450
+6 ; BEG,END: FileMan begin and end dates for report
+7 ;
+8 NEW INDEX,CNT,DAYNODE,FMDT,PPIEN,PRSNDAY
+9 SET FMDT=BEG-.1
+10 SET (INDEX,CNT)=0
+11 FOR
SET FMDT=$ORDER(^PRST(458,"AD",FMDT))
if FMDT>END!(FMDT'>0)!STOP
QUIT
Begin DoDot:1
+12 SET DAYNODE=$GET(^PRST(458,"AD",FMDT))
+13 SET PPIEN=+DAYNODE
+14 SET PRSNDAY=$PIECE(DAYNODE,U,2)
+15 ;array to hold POC data
KILL POCD
+16 DO L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
+17 if $GET(POCD(0))=0
QUIT
+18 DO DATA(.SKILMIX,GRP)
End DoDot:1
+19 ;
+20 QUIT
+21 ;
+22 ;
DATA(SKILMIX,GRP) ;Extract data from POCD array
+1 ;
+2 NEW PRSL,ST,SP,MEAL,HOURS,TT,TIEN,POC,POC1,WIEN,TW,TWD,TYPETM,TYPEWK
+3 ;
+4 SET PRSL=0
+5 FOR
SET PRSL=$ORDER(POCD(PRSL))
if PRSL'>0
QUIT
Begin DoDot:1
+6 ;
+7 ;Start and stop time and mealtime
+8 SET ST=$PIECE(POCD(PRSL),U)
SET SP=$PIECE(POCD(PRSL),U,2)
SET MEAL=$PIECE(POCD(PRSL),U,3)
+9 ;
+10 ;Get elapsed time
+11 SET HOURS=$$AMT^PRSPSAPU(ST,SP,MEAL)
+12 ;
+13 ;Type of Time code IEN
+14 SET (TIEN,TYPETM)=""
+15 SET TT=$PIECE(POCD(PRSL),U,4)
+16 IF TT'=""
Begin DoDot:2
+17 ;
+18 ;Type of Time code
+19 SET TIEN=$ORDER(^PRST(457.3,"B",TT,TIEN))
+20 if TIEN=""
QUIT
+21 ;
+22 ;Description for Type of Time code
+23 ;eg, Direct Care, AL
SET TYPETM=$PIECE(^PRST(457.3,TIEN,0),U,2)
+24 ;
End DoDot:2
+25 SET POC1=""
+26 SET POC=$PIECE(POCD(PRSL),U,5)
+27 IF POC'=""
Begin DoDot:2
+28 ;Location
SET POC1=$PIECE($$ISACTIVE^PRSNUT01(DT,POC),U,2)
End DoDot:2
+29 ;
+30 ;Type of Work Code IEN
+31 SET (TW,TWD)=""
+32 SET WIEN=$PIECE(POCD(PRSL),U,6)
+33 IF WIEN'=""
Begin DoDot:2
+34 ;
+35 ;Type of Work Code
+36 SET TW=$PIECE(^PRSN(451.5,WIEN,0),U)
+37 ;
+38 ;Description for Type of Work code
+39 SET TWD=$PIECE(^PRSN(451.5,WIEN,0),U,2)
End DoDot:2
+40 +41 ; save skill mix, hours and type of work into SKILMIX array
+42 if (TYPETM="")!(POC1="")
QUIT
+43 ;
+44 SET TYPEWK=$SELECT(TW="DC":"Direct",1:"Non Direct")
+45 SET SKILMIX(GRP,TYPETM,TYPEWK)=$GET(SKILMIX(GRP,TYPETM,TYPEWK))+HOURS
End DoDot:1
+46 QUIT
HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
SET PRTGP=1
+4 WRITE ?17,"GROUP SUMMARY ACTIVITY DIRECT AND NON DIRECT REPORT"
+5 WRITE !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$JUSTIFY(PG,3)
+6 ;blank line
WRITE !
+7 WRITE !,"Location",?22,"Type of Time",?44,"Type of Work",?75,"Hours"
+8 WRITE !,"--------------------------------------------------------------------------------"
+9 ;
+10 QUIT
PRTLP(EXTBEG,EXTEND) ;Order through SKILMIX array, total data & display
+1 NEW RNDC,LNDC,UNDC,GP,TNDC,TYPEWK,TYPETM
+2 SET GP=0
+3 FOR
SET GP=$ORDER(SKILMIX(GP))
if GP=""!STOP
QUIT
Begin DoDot:1
+4 SET TYPETM=""
SET PRTGP=1
+5 FOR
SET TYPETM=$ORDER(SKILMIX(GP,TYPETM))
if TYPETM=""!STOP
QUIT
Begin DoDot:2
+6 SET (RNDC,LNDC,UNDC,TNDC)=0
+7 SET TYPEWK=""
+8 FOR
SET TYPEWK=$ORDER(SKILMIX(GP,TYPETM,TYPEWK))
if TYPEWK=""!STOP
QUIT
Begin DoDot:3
+9 SET TOTHRS=$PIECE(SKILMIX(GP,TYPETM,TYPEWK),U)
+10 DO PPP(.STOP,EXTBEG,EXTEND)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
PPP(STOP,EXTBEG,EXTEND) ;
+1 IF PRTGP
WRITE !,GP
SET PRTGP=0
+2 WRITE ?22,TYPETM,?44,TYPEWK,?72,$JUSTIFY(TOTHRS,8,2),!
+3 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR(EXTBEG,EXTEND)
+4 QUIT
