PRSNRAS0 ;WOIFO/DAM - Group Activity - Summary and Detailed;9/10/2009
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
DEP ; Entry point for Data Entry Personnel
N GROUP
D ACCESS^PRSNUT02(.GROUP,"E",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
;
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)
; 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
;
MAIN ;
N RANGE,BEG,END,EXTBEG,EXTEND,STOP
N DAYBEG,DAYEND
N TYPE,BEG,END
S STOP=0
D TYPE
Q:STOP
D DATE
Q:STOP
D QUE
Q
;
REPORT ;for group of location or t&l
;
N PRSIEN,PRSNGLB,PRSNG,PICK,PRSNGA,PRSNGB,PG,STOP
N PRSNARY,PRSNAME,PRSNTL
K ^TMP($J,"PRSNR")
U IO
S (PICK,STOP)=0
F S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP D
. 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))))
. 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)
... Q:'+$$ISNURSE^PRSNUT01(PRSIEN)
... S PRSNARY=$G(^PRSPC(PRSIEN,0))
... S PRSNAME=$P(PRSNARY,U) ;Nurse Name
... S PRSNTL=$P(PRSNARY,U,8) ;Nurse T&L
... S ^TMP($J,"PRSNR",PICK,PRSNAME,PRSIEN)=""
;
S PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
I TYPE="S" D HDR^PRSNRAS1(EXTBEG,EXTEND)
I TYPE="D" D HDR^PRSNRAD0
S PICK=""
F S PICK=$O(^TMP($J,"PRSNR",PICK)) Q:PICK=""!STOP D
. S GHD="Location: "_PICK
. S TAB=IOM-$L(GHD)/2-5
. W !!,?TAB,GHD,!
. W ?TAB F I=1:1:$L(GHD) W "-"
. S PRSNAME=""
. Q:STOP
. F S PRSNAME=$O(^TMP($J,"PRSNR",PICK,PRSNAME)) Q:PRSNAME=""!STOP D
.. S PRSIEN=""
.. F S PRSIEN=$O(^TMP($J,"PRSNR",PICK,PRSNAME,PRSIEN)) Q:PRSIEN=""!STOP D
... I TYPE="S" D
.... ;summary report
.... D DSPLY^PRSNRAS1(PRSIEN,BEG,END,EXTBEG,EXTEND,.STOP)
... I TYPE="D" D
.... ;detailed report
.... D DSPLY^PRSNRAD0(PRSIEN,BEG,END,.STOP)
W !!,"End of Report"
D ^%ZISC
K ^TMP($J,"PRSNR")
Q
;
TYPE ;Choose summary or detailed group activity report
;
N DIR,DIRUT,X,Y
S DIR(0)="S^S:Summary Report;D:Detailed Report"
S DIR("A")="Enter Selection"
S DIR("?")="Enter whether you want to select a Summary or Detailed Group Activity Report"
D ^DIR
I $D(DIRUT) S STOP=1 Q
S TYPE=Y
Q
;
DATE ; User is prompted for a date range
;
S RANGE=$$POCRANGE^PRSNUT01()
; QUIT HERE IF RANGE=0
I +$G(RANGE)'>0 S STOP=1
;
S BEG=$P(RANGE,U)
S END=$P(RANGE,U,2)
S EXTBEG=$P(RANGE,U,3)
S EXTEND=$P(RANGE,U,4)
;
Q
;
QUE ;call to generate and display report for individual activity
N %ZIS,POP,IOP
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="GROUP ACTIVITY "_TYPE_" REPORT"
. S ZTRTN="REPORT^PRSNRAS0"
. S ZTSAVE("GROUP")=""
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("TYPE")=""
. S ZTSAVE("BEG")=""
. S ZTSAVE("END")=""
. S ZTSAVE("EXTBEG")=""
. S ZTSAVE("EXTEND")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" queued."
E D
. D REPORT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRAS0 3792 printed Sep 23, 2025@20:03:40 Page 2
PRSNRAS0 ;WOIFO/DAM - Group Activity - Summary and Detailed;9/10/2009
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
DEP ; Entry point for Data Entry Personnel
+1 NEW GROUP
+2 DO ACCESS^PRSNUT02(.GROUP,"E",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 ;
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 ; quit if any error during group selection
+5 IF $PIECE($GET(GROUP(0)),U,2)="E"
Begin DoDot:1
+6 WRITE !,$PIECE(GROUP(0),U,3)
End DoDot:1
QUIT
+7 DO MAIN
+8 ;
+9 QUIT
+10 ;
MAIN ;
+1 NEW RANGE,BEG,END,EXTBEG,EXTEND,STOP
+2 NEW DAYBEG,DAYEND
+3 NEW TYPE,BEG,END
+4 SET STOP=0
+5 DO TYPE
+6 if STOP
QUIT
+7 DO DATE
+8 if STOP
QUIT
+9 DO QUE
+10 QUIT
+11 ;
REPORT ;for group of location or t&l
+1 ;
+2 NEW PRSIEN,PRSNGLB,PRSNG,PICK,PRSNGA,PRSNGB,PG,STOP
+3 NEW PRSNARY,PRSNAME,PRSNTL
+4 KILL ^TMP($JOB,"PRSNR")
+5 USE IO
+6 SET (PICK,STOP)=0
+7 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+8 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
+9 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))))
+10 SET PRSNGA=""
+11 FOR
SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
if PRSNGA=""!STOP
QUIT
Begin DoDot:2
+12 SET PRSNGB=0
+13 FOR
SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
if 'PRSNGB!STOP
QUIT
Begin DoDot:3
+14 IF $PIECE(PRSNG,U,2)="N"
IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
QUIT
+15 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
+16 if '+$$ISNURSE^PRSNUT01(PRSIEN)
QUIT
+17 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
+18 ;Nurse Name
SET PRSNAME=$PIECE(PRSNARY,U)
+19 ;Nurse T&L
SET PRSNTL=$PIECE(PRSNARY,U,8)
+20 SET ^TMP($JOB,"PRSNR",PICK,PRSNAME,PRSIEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 SET PG=0
SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+23 IF TYPE="S"
DO HDR^PRSNRAS1(EXTBEG,EXTEND)
+24 IF TYPE="D"
DO HDR^PRSNRAD0
+25 SET PICK=""
+26 FOR
SET PICK=$ORDER(^TMP($JOB,"PRSNR",PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+27 SET GHD="Location: "_PICK
+28 SET TAB=IOM-$LENGTH(GHD)/2-5
+29 WRITE !!,?TAB,GHD,!
+30 WRITE ?TAB
FOR I=1:1:$LENGTH(GHD)
WRITE "-"
+31 SET PRSNAME=""
+32 if STOP
QUIT
+33 FOR
SET PRSNAME=$ORDER(^TMP($JOB,"PRSNR",PICK,PRSNAME))
if PRSNAME=""!STOP
QUIT
Begin DoDot:2
+34 SET PRSIEN=""
+35 FOR
SET PRSIEN=$ORDER(^TMP($JOB,"PRSNR",PICK,PRSNAME,PRSIEN))
if PRSIEN=""!STOP
QUIT
Begin DoDot:3
+36 IF TYPE="S"
Begin DoDot:4
+37 ;summary report
+38 DO DSPLY^PRSNRAS1(PRSIEN,BEG,END,EXTBEG,EXTEND,.STOP)
End DoDot:4
+39 IF TYPE="D"
Begin DoDot:4
+40 ;detailed report
+41 DO DSPLY^PRSNRAD0(PRSIEN,BEG,END,.STOP)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 WRITE !!,"End of Report"
+43 DO ^%ZISC
+44 KILL ^TMP($JOB,"PRSNR")
+45 QUIT
+46 ;
TYPE ;Choose summary or detailed group activity report
+1 ;
+2 NEW DIR,DIRUT,X,Y
+3 SET DIR(0)="S^S:Summary Report;D:Detailed Report"
+4 SET DIR("A")="Enter Selection"
+5 SET DIR("?")="Enter whether you want to select a Summary or Detailed Group Activity Report"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET STOP=1
QUIT
+8 SET TYPE=Y
+9 QUIT
+10 ;
DATE ; User is prompted for a date range
+1 ;
+2 SET RANGE=$$POCRANGE^PRSNUT01()
+3 ; QUIT HERE IF RANGE=0
+4 IF +$GET(RANGE)'>0
SET STOP=1
+5 ;
+6 SET BEG=$PIECE(RANGE,U)
+7 SET END=$PIECE(RANGE,U,2)
+8 SET EXTBEG=$PIECE(RANGE,U,3)
+9 SET EXTEND=$PIECE(RANGE,U,4)
+10 ;
+11 QUIT
+12 ;
QUE ;call to generate and display report for individual activity
+1 NEW %ZIS,POP,IOP
+2 SET %ZIS="MQ"
+3 DO ^%ZIS
+4 if POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 KILL IO("Q")
+7 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+8 SET ZTDESC="GROUP ACTIVITY "_TYPE_" REPORT"
+9 SET ZTRTN="REPORT^PRSNRAS0"
+10 SET ZTSAVE("GROUP")=""
+11 SET ZTSAVE("GROUP(")=""
+12 SET ZTSAVE("TYPE")=""
+13 SET ZTSAVE("BEG")=""
+14 SET ZTSAVE("END")=""
+15 SET ZTSAVE("EXTBEG")=""
+16 SET ZTSAVE("EXTEND")=""
+17 DO ^%ZTLOAD
+18 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" queued."
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 DO REPORT
End DoDot:1
+21 QUIT
