PRSNRND0 ;WOIFO/DAM - Non Direct Care Summary by Skill Mix I REPORT;9/10/2009
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
;
;
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)
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,TYPE,BEG,END
S STOP=0
D DATE
Q:STOP
D QUE
Q
;
REPORT ;for group of location or t&l
;
N X,PRSIEN,PRSNGLB,PRSNG,GRP,SORT,PRSNGA,PRSNGB,SKILMIX,NUROLE,PICK,PG
U IO
S SORT=$P(GROUP(0),U,2),PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
D HDR^PRSNRND1(EXTBEG,EXTEND)
S (PICK,STOP)=0
F S PICK=$O(GROUP(PICK)) Q:PICK="" 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 GRP=$P(PRSNG,U,3) ;External form of primary location
. S PRSNGA=""
. F S PRSNGA=$O(@PRSNGLB@(PRSNGA)) QUIT:PRSNGA="" D
.. S PRSNGB=0
.. F S PRSNGB=$O(@PRSNGLB@(PRSNGA,PRSNGB)) QUIT:'PRSNGB 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)
... S X=$$ISNURSE^PRSNUT01(PRSIEN)
... I +X D
.... S NUROLE=$P(X,U,2)
.... D GATHER^PRSNRND1(.SKILMIX,GRP,NUROLE,PRSIEN,BEG,END)
D PRTLP^PRSNRND1(EXTBEG,EXTEND)
W !!,"End of Report"
D ^%ZISC
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 Q
;
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 WORK SUMMARY BY SKILLMIX"
. S ZTRTN="REPORT^PRSNRND0"
. 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[HPRSNRND0 2564 printed Dec 13, 2024@02:27:31 Page 2
PRSNRND0 ;WOIFO/DAM - Non Direct Care Summary by Skill Mix I REPORT;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
+3 ;
+4 ;
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 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 ;
+8 QUIT
+9 ;
MAIN ;
+1 NEW RANGE,BEG,END,EXTBEG,EXTEND,STOP,TYPE,BEG,END
+2 SET STOP=0
+3 DO DATE
+4 if STOP
QUIT
+5 DO QUE
+6 QUIT
+7 ;
REPORT ;for group of location or t&l
+1 ;
+2 NEW X,PRSIEN,PRSNGLB,PRSNG,GRP,SORT,PRSNGA,PRSNGB,SKILMIX,NUROLE,PICK,PG
+3 USE IO
+4 SET SORT=$PIECE(GROUP(0),U,2)
SET PG=0
SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+5 DO HDR^PRSNRND1(EXTBEG,EXTEND)
+6 SET (PICK,STOP)=0
+7 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""
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 ;External form of primary location
SET GRP=$PIECE(PRSNG,U,3)
+11 SET PRSNGA=""
+12 FOR
SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
if PRSNGA=""
QUIT
Begin DoDot:2
+13 SET PRSNGB=0
+14 FOR
SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
if 'PRSNGB
QUIT
Begin DoDot:3
+15 IF $PIECE(PRSNG,U,2)="N"
IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
QUIT
+16 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
+17 SET X=$$ISNURSE^PRSNUT01(PRSIEN)
+18 IF +X
Begin DoDot:4
+19 SET NUROLE=$PIECE(X,U,2)
+20 DO GATHER^PRSNRND1(.SKILMIX,GRP,NUROLE,PRSIEN,BEG,END)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 DO PRTLP^PRSNRND1(EXTBEG,EXTEND)
+22 WRITE !!,"End of Report"
+23 DO ^%ZISC
+24 QUIT
+25 ;
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
QUIT
+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 WORK SUMMARY BY SKILLMIX"
+9 SET ZTRTN="REPORT^PRSNRND0"
+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
