Routine: PRSNRAS0

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

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

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

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

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")

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

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)

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRAS0   3792     printed  Apr 23, 2025@18:41:49                                                                                                                                                                                                    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

PRSNRAS0.m