PRSNREV0 ;WOIFO/DAM - Nursing Education Validation/Position and Pay Reports ;9/10/2009
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
QUIT
;
COORDNPP ;entry point of nurse position and pay information
S PRSNOPT=2
D MAIN
Q
COORD ;Entry point for VANOD Coordinator
S PRSNOPT=1
D MAIN
Q
;
MAIN ;call to generate and display report for individual activity
;
; 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)
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=$P("Nursing Education Validation Report^Nurse Position and Pay Information Report",PRSNOPT)
. S ZTRTN="REPORT^PRSNREV0"
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("TYPE")=""
. S ZTSAVE("PRSNOPT")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D
. D REPORT
;
K PRSNOPT
Q
;
REPORT ;for group of location or t&l
;
N PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG
U IO
S SORT=$P(GROUP(0),U,2),PG=0
D HDR^PRSNREV1(PRSNOPT)
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))))
. ;
. ; display and underline group sub header
. ;
. 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 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
... D DSPLY^PRSNREV1(PRSIEN,PRSNOPT,NURSE,.STOP)
W !!,"End of Report"
D ^%ZISC
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNREV0 2154 printed Apr 09, 2024@21:30:25 Page 2
PRSNREV0 ;WOIFO/DAM - Nursing Education Validation/Position and Pay Reports ;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 QUIT
+4 ;
COORDNPP ;entry point of nurse position and pay information
+1 SET PRSNOPT=2
+2 DO MAIN
+3 QUIT
COORD ;Entry point for VANOD Coordinator
+1 SET PRSNOPT=1
+2 DO MAIN
+3 QUIT
+4 ;
MAIN ;call to generate and display report for individual activity
+1 ;
+2 ; Coordinator has no access limits so let them pick any group
+3 NEW GROUP
+4 DO PIKGROUP^PRSNUT04(.GROUP,"",1)
+5 IF $PIECE($GET(GROUP(0)),U,2)="E"
Begin DoDot:1
+6 WRITE !,$PIECE(GROUP(0),U,3)
End DoDot:1
QUIT
+7 NEW %ZIS,POP,IOP
+8 SET %ZIS="MQ"
+9 DO ^%ZIS
+10 if POP
QUIT
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 KILL IO("Q")
+13 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+14 SET ZTDESC=$PIECE("Nursing Education Validation Report^Nurse Position and Pay Information Report",PRSNOPT)
+15 SET ZTRTN="REPORT^PRSNREV0"
+16 SET ZTSAVE("GROUP(")=""
+17 SET ZTSAVE("TYPE")=""
+18 SET ZTSAVE("PRSNOPT")=""
+19 DO ^%ZTLOAD
+20 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 DO REPORT
End DoDot:1
+23 ;
+24 KILL PRSNOPT
+25 QUIT
+26 ;
REPORT ;for group of location or t&l
+1 ;
+2 NEW PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG
+3 USE IO
+4 SET SORT=$PIECE(GROUP(0),U,2)
SET PG=0
+5 DO HDR^PRSNREV1(PRSNOPT)
+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 ;
+11 ; display and underline group sub header
+12 ;
+13 SET GHD=$SELECT($PIECE(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_": "_$PIECE(PRSNG,U,3)
+14 SET TAB=IOM-$LENGTH(GHD)/2-5
+15 WRITE !!,?TAB,GHD,!
+16 WRITE ?TAB
FOR I=1:1:$LENGTH(GHD)
WRITE "-"
+17 ;
+18 SET PRSNGA=""
+19 FOR
SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
if PRSNGA=""!STOP
QUIT
Begin DoDot:2
+20 SET PRSNGB=0
+21 FOR
SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
if 'PRSNGB!STOP
QUIT
Begin DoDot:3
+22 IF $PIECE(PRSNG,U,2)="N"
IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
QUIT
+23 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
+24 SET NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
+25 if '+NURSE
QUIT
+26 DO DSPLY^PRSNREV1(PRSIEN,PRSNOPT,NURSE,.STOP)
End DoDot:3
End DoDot:2
End DoDot:1
+27 WRITE !!,"End of Report"
+28 DO ^%ZISC
+29 QUIT
+30 ;
