PRSNRGS0 ;WOIFO/KJS - Nursing LOCATION Summary 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,"N",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
;
S STOP=0
D DATE
Q:STOP
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 Summary Report"
. S ZTRTN="REPORT^PRSNRGS0"
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("LOCDT")=""
. S ZTSAVE("LOCDTE")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D REPORT
;
Q
;
DATE ; User is prompted for a date range
;
; GET START DATE
N %DT,Y,X
S %DT="AEP"
S %DT("A")="Date: "
S Y=DT D DD^%DT S %DT("B")=Y
;
D ^%DT
I +$G(Y)'>0 S STOP=1 Q
;
S LOCDT=Y D DD^%DT S LOCDTE=Y
;
Q
;
REPORT ;for group of location or t&l
;
N PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,I,PRSNGA,PRSNGB,TAB,PG,TOTUAP,TOTLPN,TOTRN
N FIELDS,ACTIVE,STATUS,DSS,DAP,DEP,VANOD,LN
U IO
S SORT=$P(GROUP(0),U,2),PG=0
K ^TMP($J)
D HDR
S (PICK,STOP)=0
F S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP D
.S (TOTUAP,TOTLPN,TOTRN)=0
.S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK),LOCN=$P(PRSNG,U,7)
.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 SKILL=$P(NURSE,U,2)
...I SKILL["RN" S TOTRN=TOTRN+1
...I SKILL["LPN" S TOTLPN=TOTLPN+1
...I SKILL'["RN",SKILL'["LPN" S TOTUAP=TOTUAP+1
.Q:STOP
.S LOCIEN=$O(^NURSF(211.4,"B",LOCN,""))
.S STATUS=$$ISACTIVE^PRSNUT01(LOCDT,LOCIEN)
.S ACTIVE=$S(+STATUS:"Active",1:"Inactive")
.K FIELDS
.S IENS=LOCIEN_","
.D GETS^DIQ(211.4,IENS,".01;.6;.7;2*;14*;15*","IE","FIELDS(",,)
.S VANOD=FIELDS(211.4,IENS,.6,"E")
.S DSS=FIELDS(211.4,IENS,.7,"E")
.S (MASIENS,DAPIENS,DEPIENS)="",MASSTOP=0
.F LN=1:1 D Q:MASSTOP!STOP
..S MASIENS=$O(FIELDS(211.41,MASIENS))
..I MASIENS="" S MASSTOP=1
..S MAS=$S(MASSTOP:"",1:FIELDS(211.41,MASIENS,.01,"E"))
..I LN>1,MASSTOP Q ;MUST PRINT AT LEAST 1 LINE
..D PRT1
.Q:STOP
.S (DEPSTOP,DAPSTOP)=0
.F LN=1:1 D Q:(DAPSTOP&DEPSTOP)!STOP
..S DEPIENS=$O(FIELDS(211.414,DEPIENS))
..I DEPIENS="" S DEPSTOP=1
..S DEP=$S(DEPSTOP:"",1:FIELDS(211.414,DEPIENS,.01,"E"))
..S DAPIENS=$O(FIELDS(211.415,DAPIENS))
..I DAPIENS="" S DAPSTOP=1
..S DAP=$S(DAPSTOP:"",1:FIELDS(211.415,DAPIENS,.01,"E"))
..I LN>1,DAPSTOP,DEPSTOP Q ;MUST PRINT AT LEAST 1 LINE
..D PRT2
W !!,"End of Report"
D ^%ZISC
K ^TMP($J)
Q
;
HDR ;Display header
;
W @IOF
S PG=PG+1
W "Nursing Location Summary Report For Date: ",LOCDTE
W !,?45,"Run Date: ",$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3)," Page: ",$J(PG,3)
;nurse position and pay
W !!,"Nurse Location",?20,"MAS Ward",?40,"VANOD Unit Type",?60,"DSS Unit Type"
W !,?5,"Status",?15,"Data Approval",?35,"Data Entry",?64,"#RNs",?69,"#LPNs",?75,"#UAPs"
W !,"--------------------------------------------------------------------------------"
;
QUIT
;
PRT1 ;
;print position and pay report
W !
W:LN=1 $E(PICK,1,19)
W ?20,$E(MAS,1,19)
W:LN=1 ?40,$E(VANOD,1,19),?60,$E(DSS,1,19)
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
Q
;
PRT2 ;
;print position and pay report
W !
W:LN=1 ?5,ACTIVE
W ?15,$E(DAP,1,19),?35,$E(DEP,1,19)
W:LN=1 ?64,$J(TOTRN,4,0),?70,$J(TOTLPN,4,0),?76,$J(TOTUAP,4,0)
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRGS0 4126 printed Sep 23, 2025@20:03:48 Page 2
PRSNRGS0 ;WOIFO/KJS - Nursing LOCATION Summary 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,"N",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 SET STOP=0
+3 DO DATE
+4 if STOP
QUIT
+5 NEW %ZIS,POP,IOP
+6 SET %ZIS="MQ"
+7 DO ^%ZIS
+8 if POP
QUIT
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 KILL IO("Q")
+11 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+12 SET ZTDESC="Nursing Location Summary Report"
+13 SET ZTRTN="REPORT^PRSNRGS0"
+14 SET ZTSAVE("GROUP(")=""
+15 SET ZTSAVE("LOCDT")=""
+16 SET ZTSAVE("LOCDTE")=""
+17 DO ^%ZTLOAD
+18 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+19 IF '$TEST
DO REPORT
+20 ;
+21 QUIT
+22 ;
DATE ; User is prompted for a date range
+1 ;
+2 ; GET START DATE
+3 NEW %DT,Y,X
+4 SET %DT="AEP"
+5 SET %DT("A")="Date: "
+6 SET Y=DT
DO DD^%DT
SET %DT("B")=Y
+7 ;
+8 DO ^%DT
+9 IF +$GET(Y)'>0
SET STOP=1
QUIT
+10 ;
+11 SET LOCDT=Y
DO DD^%DT
SET LOCDTE=Y
+12 ;
+13 QUIT
+14 ;
REPORT ;for group of location or t&l
+1 ;
+2 NEW PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,I,PRSNGA,PRSNGB,TAB,PG,TOTUAP,TOTLPN,TOTRN
+3 NEW FIELDS,ACTIVE,STATUS,DSS,DAP,DEP,VANOD,LN
+4 USE IO
+5 SET SORT=$PIECE(GROUP(0),U,2)
SET PG=0
+6 KILL ^TMP($JOB)
+7 DO HDR
+8 SET (PICK,STOP)=0
+9 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+10 SET (TOTUAP,TOTLPN,TOTRN)=0
+11 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
SET LOCN=$PIECE(PRSNG,U,7)
+12 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))))
+13 ;
+14 ;
+15 KILL ^TMP($JOB)
+16 SET PRSNGA=""
+17 FOR
SET PRSNGA=$ORDER(@PRSNGLB@(PRSNGA))
if PRSNGA=""!STOP
QUIT
Begin DoDot:2
+18 SET PRSNGB=0
+19 FOR
SET PRSNGB=$ORDER(@PRSNGLB@(PRSNGA,PRSNGB))
if 'PRSNGB!STOP
QUIT
Begin DoDot:3
+20 IF $PIECE(PRSNG,U,2)="N"
IF +$PIECE(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB)
QUIT
+21 SET PRSIEN=$SELECT($PIECE(PRSNG,U,2)="N":+$GET(^VA(200,PRSNGB,450)),1:PRSNGB)
+22 SET NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
+23 if '+NURSE
QUIT
+24 SET SKILL=$PIECE(NURSE,U,2)
+25 IF SKILL["RN"
SET TOTRN=TOTRN+1
+26 IF SKILL["LPN"
SET TOTLPN=TOTLPN+1
+27 IF SKILL'["RN"
IF SKILL'["LPN"
SET TOTUAP=TOTUAP+1
End DoDot:3
End DoDot:2
+28 if STOP
QUIT
+29 SET LOCIEN=$ORDER(^NURSF(211.4,"B",LOCN,""))
+30 SET STATUS=$$ISACTIVE^PRSNUT01(LOCDT,LOCIEN)
+31 SET ACTIVE=$SELECT(+STATUS:"Active",1:"Inactive")
+32 KILL FIELDS
+33 SET IENS=LOCIEN_","
+34 DO GETS^DIQ(211.4,IENS,".01;.6;.7;2*;14*;15*","IE","FIELDS(",,)
+35 SET VANOD=FIELDS(211.4,IENS,.6,"E")
+36 SET DSS=FIELDS(211.4,IENS,.7,"E")
+37 SET (MASIENS,DAPIENS,DEPIENS)=""
SET MASSTOP=0
+38 FOR LN=1:1
Begin DoDot:2
+39 SET MASIENS=$ORDER(FIELDS(211.41,MASIENS))
+40 IF MASIENS=""
SET MASSTOP=1
+41 SET MAS=$SELECT(MASSTOP:"",1:FIELDS(211.41,MASIENS,.01,"E"))
+42 ;MUST PRINT AT LEAST 1 LINE
IF LN>1
IF MASSTOP
QUIT
+43 DO PRT1
End DoDot:2
if MASSTOP!STOP
QUIT
+44 if STOP
QUIT
+45 SET (DEPSTOP,DAPSTOP)=0
+46 FOR LN=1:1
Begin DoDot:2
+47 SET DEPIENS=$ORDER(FIELDS(211.414,DEPIENS))
+48 IF DEPIENS=""
SET DEPSTOP=1
+49 SET DEP=$SELECT(DEPSTOP:"",1:FIELDS(211.414,DEPIENS,.01,"E"))
+50 SET DAPIENS=$ORDER(FIELDS(211.415,DAPIENS))
+51 IF DAPIENS=""
SET DAPSTOP=1
+52 SET DAP=$SELECT(DAPSTOP:"",1:FIELDS(211.415,DAPIENS,.01,"E"))
+53 ;MUST PRINT AT LEAST 1 LINE
IF LN>1
IF DAPSTOP
IF DEPSTOP
QUIT
+54 DO PRT2
End DoDot:2
if (DAPSTOP&DEPSTOP)!STOP
QUIT
End DoDot:1
+55 WRITE !!,"End of Report"
+56 DO ^%ZISC
+57 KILL ^TMP($JOB)
+58 QUIT
+59 ;
HDR ;Display header
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
+4 WRITE "Nursing Location Summary Report For Date: ",LOCDTE
+5 WRITE !,?45,"Run Date: ",$EXTRACT(DT,4,5),"/",$EXTRACT(DT,6,7),"/",$EXTRACT(DT,2,3)," Page: ",$JUSTIFY(PG,3)
+6 ;nurse position and pay
+7 WRITE !!,"Nurse Location",?20,"MAS Ward",?40,"VANOD Unit Type",?60,"DSS Unit Type"
+8 WRITE !,?5,"Status",?15,"Data Approval",?35,"Data Entry",?64,"#RNs",?69,"#LPNs",?75,"#UAPs"
+9 WRITE !,"--------------------------------------------------------------------------------"
+10 ;
+11 QUIT
+12 ;
PRT1 ;
+1 ;print position and pay report
+2 WRITE !
+3 if LN=1
WRITE $EXTRACT(PICK,1,19)
+4 WRITE ?20,$EXTRACT(MAS,1,19)
+5 if LN=1
WRITE ?40,$EXTRACT(VANOD,1,19),?60,$EXTRACT(DSS,1,19)
+6 ;
+7 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR
+8 QUIT
+9 ;
PRT2 ;
+1 ;print position and pay report
+2 WRITE !
+3 if LN=1
WRITE ?5,ACTIVE
+4 WRITE ?15,$EXTRACT(DAP,1,19),?35,$EXTRACT(DEP,1,19)
+5 if LN=1
WRITE ?64,$JUSTIFY(TOTRN,4,0),?70,$JUSTIFY(TOTLPN,4,0),?76,$JUSTIFY(TOTUAP,4,0)
+6 ;
+7 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR
+8 QUIT
