PRSNRAD0 ;WOIFO/DAM - POC GROUP ACTIVITY DETAILED REPORT ;060409
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
;
;
;
DSPLY(PRSIEN,BEG,END,STOP) ;Entry point to gather POC data from 451
;INPUT:
; PRSIEN: Nurse ien 450
; BEG,END: FileMan begin and end dates for report
;
N EXTBEG,EXTEND,FMDT
N PRSNAME,PRSNTL,SKILMIX,PRSNSSN,PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY
N PPIEN,PRSL,PRSNDAY,STARTDT,STDE,DATE,DAYNODE,FMDT
N MEAL,PRSNM,PRSNPOC,PRSNRE,PRSNREC,PRSNRIEN,PRSNSP,PRSNST
N PRSNTIEN,PRSNTT,PRSNTW,PRSNWIEN,POCD,PRSD
D INITIAL
D INFO^PRSNRAS1
S FMDT=BEG-.1
N INDEX,CNT,DAYNODE
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),PRSD=1
. K POCD ;array to hold POC data
. D L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
. Q:$G(POCD(0))=0
. D DATA
;
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
;
HDR ;Display header for report of Individual Nurse Activity
;
W @IOF
S PG=PG+1
W ?25,"GROUP ACTIVITY DETAIL REPORT"
W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
W ! ;blank line
W !,"Nurse Name",?21,"Last 4",?29,"Start/",?38,"Type of",?49,"Mand",?57,"Meal",?65,"Location/"
W !,"Skill Mix",?23,"SSN/",?29,"Stop",?39,"Time",?50,"OT",?57,"Time",?64,"Type of Work"
W !,"Date",?23,"T&L",?29,"Time"
W !,"--------------------------------------------------------------------------------"
;
Q
;
DATA ;Extract display data from POCD array and get external date
;
N PRSEQ
S (PRSNST,PRSNSP,PRSNPOC,PRSNTT,PRSNWIEN)=""
S (PRSNTW,PRSNM,PRSNRE,PRSNREC,PRSNRIEN)=""
S (PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY,DATE,MEAL)=""
S PRSNTIEN=0
;
;
;Get external date in form of MM/DD/YY
N DATE S DATE=$E(FMDT,4,5)_"/"_$E(FMDT,6,7)_"/"_$E(FMDT,2,3)
;
;Get data from POCD array
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)
. ;
. ;Type of Time code IEN
. S PRSNTT=$P(POCD(PRSEQ),U,4),PRSNTIEN=" ",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),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(PRSEQ),U,7)
. D PRT
;
Q
;
PRT ;Print report
I PRSL W !,$E(PRSNAME,1,19)
;PUT DATE ON FIRST LINE IF NAME & SKILL ARE NOT PRINTED
I 'PRSL,PRSD W !," ",DATE
W ?22,$E(PRSNSSN,6,9)
W ?29,PRSNST
W ?38,PRSNLNG
W ?51,PRSNM
W ?58,MEAL
W ?65,$E(PRSNPOC1,1,14)
W !
I PRSL W " ",$E(SKILMIX,1,17)
W ?22,PRSNTL
W ?29,PRSNSP
W ?65,$E(PRSNTWD,1,14)
W !
;PUT DATE ON THIRD LINE IF NAME & SKILL ARE PRINTED
I PRSL,PRSD W " ",DATE,!
S (PRSL,PRSD)=0
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRAD0 3575 printed Sep 23, 2025@20:03:39 Page 2
PRSNRAD0 ;WOIFO/DAM - POC GROUP ACTIVITY DETAILED 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 ;
+5 ;
DSPLY(PRSIEN,BEG,END,STOP) ;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 EXTBEG,EXTEND,FMDT
+6 NEW PRSNAME,PRSNTL,SKILMIX,PRSNSSN,PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY
+7 NEW PPIEN,PRSL,PRSNDAY,STARTDT,STDE,DATE,DAYNODE,FMDT
+8 NEW MEAL,PRSNM,PRSNPOC,PRSNRE,PRSNREC,PRSNRIEN,PRSNSP,PRSNST
+9 NEW PRSNTIEN,PRSNTT,PRSNTW,PRSNWIEN,POCD,PRSD
+10 DO INITIAL
+11 DO INFO^PRSNRAS1
+12 SET FMDT=BEG-.1
+13 NEW INDEX,CNT,DAYNODE
+14 SET (INDEX,CNT)=0
+15 FOR
SET FMDT=$ORDER(^PRST(458,"AD",FMDT))
if FMDT>END!(FMDT'>0)!STOP
QUIT
Begin DoDot:1
+16 SET DAYNODE=$GET(^PRST(458,"AD",FMDT))
+17 SET PPIEN=+DAYNODE
+18 SET PRSNDAY=$PIECE(DAYNODE,U,2)
SET PRSD=1
+19 ;array to hold POC data
KILL POCD
+20 DO L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
+21 if $GET(POCD(0))=0
QUIT
+22 DO DATA
End DoDot:1
+23 ;
+24 QUIT
+25 ;
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
+6 ;
HDR ;Display header for report of Individual Nurse Activity
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
+4 WRITE ?25,"GROUP ACTIVITY DETAIL REPORT"
+5 WRITE !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$JUSTIFY(PG,3)
+6 ;blank line
WRITE !
+7 WRITE !,"Nurse Name",?21,"Last 4",?29,"Start/",?38,"Type of",?49,"Mand",?57,"Meal",?65,"Location/"
+8 WRITE !,"Skill Mix",?23,"SSN/",?29,"Stop",?39,"Time",?50,"OT",?57,"Time",?64,"Type of Work"
+9 WRITE !,"Date",?23,"T&L",?29,"Time"
+10 WRITE !,"--------------------------------------------------------------------------------"
+11 ;
+12 QUIT
+13 ;
DATA ;Extract display data from POCD array and get external date
+1 ;
+2 NEW PRSEQ
+3 SET (PRSNST,PRSNSP,PRSNPOC,PRSNTT,PRSNWIEN)=""
+4 SET (PRSNTW,PRSNM,PRSNRE,PRSNREC,PRSNRIEN)=""
+5 SET (PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY,DATE,MEAL)=""
+6 SET PRSNTIEN=0
+7 ;
+8 ;
+9 ;Get external date in form of MM/DD/YY
+10 NEW DATE
SET DATE=$EXTRACT(FMDT,4,5)_"/"_$EXTRACT(FMDT,6,7)_"/"_$EXTRACT(FMDT,2,3)
+11 ;
+12 ;Get data from POCD array
+13 SET PRSEQ=0
+14 FOR
SET PRSEQ=$ORDER(POCD(PRSEQ))
if PRSEQ'>0!STOP
QUIT
Begin DoDot:1
+15 ;Start Time
+16 SET PRSNST=$PIECE(POCD(PRSEQ),U)
+17 ;
+18 ;Stop Time
+19 SET PRSNSP=$PIECE(POCD(PRSEQ),U,2)
+20 ;
+21 ;Meal Time
+22 SET MEAL=$PIECE(POCD(PRSEQ),U,3)
+23 ;
+24 ;Type of Time code IEN
+25 SET PRSNTT=$PIECE(POCD(PRSEQ),U,4)
SET PRSNTIEN=" "
SET PRSNLNG=" "
+26 IF PRSNTT'=""
Begin DoDot:2
+27 ;
+28 ;Type of Time code
+29 SET PRSNTIEN=$ORDER(^PRST(457.3,"B",PRSNTT,0))
if PRSNTIEN=""
QUIT
+30 ;
+31 ;Description for Type of Time code
+32 SET PRSNLNG=$PIECE(^PRST(457.3,PRSNTIEN,0),U,2)
+33 ;
End DoDot:2
+34 SET PRSNPOC=$PIECE(POCD(PRSEQ),U,5)
SET PRSNPOC1=" "
+35 IF PRSNPOC'=""
Begin DoDot:2
+36 ;POC
+37 SET PRSNPOC1=$PIECE($$ISACTIVE^PRSNUT01(DT,PRSNPOC),U,2)
End DoDot:2
+38 ;
+39 ;Type of Work Code IEN
+40 SET PRSNWIEN=$PIECE(POCD(PRSEQ),U,6)
SET PRSNTW=" "
SET PRSNTWD=" "
+41 IF PRSNWIEN'=""
Begin DoDot:2
+42 ;
+43 ;Type of Work Code
+44 SET PRSNTW=$PIECE(^PRSN(451.5,PRSNWIEN,0),U)
+45 ;
+46 ;Description for Type of Work code
+47 SET PRSNTWD=$PIECE(^PRSN(451.5,PRSNWIEN,0),U,2)
End DoDot:2
+48 ;
+49 ;OT Mandatory/Voluntary
+50 SET PRSNM=$PIECE(POCD(PRSEQ),U,7)
+51 DO PRT
End DoDot:1
+52 ;
+53 QUIT
+54 ;
PRT ;Print report
+1 IF PRSL
WRITE !,$EXTRACT(PRSNAME,1,19)
+2 ;PUT DATE ON FIRST LINE IF NAME & SKILL ARE NOT PRINTED
+3 IF 'PRSL
IF PRSD
WRITE !," ",DATE
+4 WRITE ?22,$EXTRACT(PRSNSSN,6,9)
+5 WRITE ?29,PRSNST
+6 WRITE ?38,PRSNLNG
+7 WRITE ?51,PRSNM
+8 WRITE ?58,MEAL
+9 WRITE ?65,$EXTRACT(PRSNPOC1,1,14)
+10 WRITE !
+11 IF PRSL
WRITE " ",$EXTRACT(SKILMIX,1,17)
+12 WRITE ?22,PRSNTL
+13 WRITE ?29,PRSNSP
+14 WRITE ?65,$EXTRACT(PRSNTWD,1,14)
+15 WRITE !
+16 ;PUT DATE ON THIRD LINE IF NAME & SKILL ARE PRINTED
+17 IF PRSL
IF PRSD
WRITE " ",DATE,!
+18 SET (PRSL,PRSD)=0
+19 ;
+20 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR
+21 QUIT
