PRSNRGD0 ;WOIFO/KJS - Nursing LOCATION DETAIL Report ;8/2/2011
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
QUIT
;
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 ;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="Nursing Location Detail Report"
. S ZTRTN="REPORT^PRSNRGD0"
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("TYPE")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D REPORT
;
Q
;
REPORT ;for group of location or t&l
;
N PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG,FTEE,TOTNUR,TOTFTEE
U IO
S SORT=$P(GROUP(0),U,2),PG=0,(FTEE,TOTFTEE,TOTNUR)=0
K ^TMP($J)
D HDR^PRSNRGD1
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))))
.;
.;
.K ^TMP($J)
.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)
...S NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
...Q:'+NURSE
...S JOB=$$GETCODES^PRSNUT01(PRSIEN) ;Job codes
...S BOC=$P(JOB,U)
...S OCC=$P(JOB,U,2)
...D INFO^PRSNRAS1
...S ^TMP($J,OCC,PRSNAME,PRSIEN)=NURSE
.; display and underline group sub header
.;
.Q:STOP
.S GHD=$S($P(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_": "_$P(PRSNG,U,3)
.S TAB=IOM-$L(GHD)/2-5
.W !!,?TAB,GHD,!
.W ?TAB F I=1:1:$L(GHD) W "-"
.S S1=""
.F S S1=$O(^TMP($J,S1)) Q:S1=""!STOP D
..S S2=""
..F S S2=$O(^TMP($J,S1,S2)) Q:S2=""!STOP D
...S PRSIEN=""
...F S PRSIEN=$O(^TMP($J,S1,S2,PRSIEN)) Q:PRSIEN=""!STOP D
....S NURSE=^TMP($J,S1,S2,PRSIEN)
....D DSPLY^PRSNRGD1(PRSIEN,NURSE,.STOP)
W !!,?40,"Total Nurses: ",$J(TOTNUR,4),?60,"Total FTEE: ",?72,$J(TOTFTEE,8,2)
W !!,"End of Report"
D ^%ZISC
K ^TMP($J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRGD0 2451 printed Nov 22, 2024@17:37:25 Page 2
PRSNRGD0 ;WOIFO/KJS - Nursing LOCATION DETAIL Report ;8/2/2011
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
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 QUIT
+8 ;
MAIN ;call to generate and display report for individual activity
+1 ;
+2 NEW %ZIS,POP,IOP
+3 SET %ZIS="MQ"
+4 DO ^%ZIS
+5 if POP
QUIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 KILL IO("Q")
+8 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+9 SET ZTDESC="Nursing Location Detail Report"
+10 SET ZTRTN="REPORT^PRSNRGD0"
+11 SET ZTSAVE("GROUP(")=""
+12 SET ZTSAVE("TYPE")=""
+13 DO ^%ZTLOAD
+14 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+15 IF '$TEST
DO REPORT
+16 ;
+17 QUIT
+18 ;
REPORT ;for group of location or t&l
+1 ;
+2 NEW PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG,FTEE,TOTNUR,TOTFTEE
+3 USE IO
+4 SET SORT=$PIECE(GROUP(0),U,2)
SET PG=0
SET (FTEE,TOTFTEE,TOTNUR)=0
+5 KILL ^TMP($JOB)
+6 DO HDR^PRSNRGD1
+7 SET (PICK,STOP)=0
+8 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+9 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
+10 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))))
+11 ;
+12 ;
+13 KILL ^TMP($JOB)
+14 SET PRSNGA=""
+15 FOR
SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
if PRSNGA=""!STOP
QUIT
Begin DoDot:2
+16 SET PRSNGB=0
+17 FOR
SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
if 'PRSNGB!STOP
QUIT
Begin DoDot:3
+18 IF $PIECE(PRSNG,U,2)="N"
IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
QUIT
+19 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
+20 SET NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
+21 if '+NURSE
QUIT
+22 ;Job codes
SET JOB=$$GETCODES^PRSNUT01(PRSIEN)
+23 SET BOC=$PIECE(JOB,U)
+24 SET OCC=$PIECE(JOB,U,2)
+25 DO INFO^PRSNRAS1
+26 SET ^TMP($JOB,OCC,PRSNAME,PRSIEN)=NURSE
End DoDot:3
End DoDot:2
+27 ; display and underline group sub header
+28 ;
+29 if STOP
QUIT
+30 SET GHD=$SELECT($PIECE(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_": "_$PIECE(PRSNG,U,3)
+31 SET TAB=IOM-$LENGTH(GHD)/2-5
+32 WRITE !!,?TAB,GHD,!
+33 WRITE ?TAB
FOR I=1:1:$LENGTH(GHD)
WRITE "-"
+34 SET S1=""
+35 FOR
SET S1=$ORDER(^TMP($JOB,S1))
if S1=""!STOP
QUIT
Begin DoDot:2
+36 SET S2=""
+37 FOR
SET S2=$ORDER(^TMP($JOB,S1,S2))
if S2=""!STOP
QUIT
Begin DoDot:3
+38 SET PRSIEN=""
+39 FOR
SET PRSIEN=$ORDER(^TMP($JOB,S1,S2,PRSIEN))
if PRSIEN=""!STOP
QUIT
Begin DoDot:4
+40 SET NURSE=^TMP($JOB,S1,S2,PRSIEN)
+41 DO DSPLY^PRSNRGD1(PRSIEN,NURSE,.STOP)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 WRITE !!,?40,"Total Nurses: ",$JUSTIFY(TOTNUR,4),?60,"Total FTEE: ",?72,$JUSTIFY(TOTFTEE,8,2)
+43 WRITE !!,"End of Report"
+44 DO ^%ZISC
+45 KILL ^TMP($JOB)
+46 QUIT
+47 ;