PRSNUT05 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/5/2009
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
SHOWSU ; SHOW SYSTEM SETUP WITH DIVISIONS, NURSE LOCATIONS AND T&Ls
;
N %ZIS,POP,IOP,DIVMAP,DIVS
D BLDMAP(.DIVMAP)
S DIVS=$$SELECT(.DIVMAP)
Q:DIVS=0
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="PRSN SHOW SYSTEM SETUP REPORT"
. S ZTRTN="MAIN^PRSNUT05"
. S ZTSAVE("DIVMAP(")=""
. S ZTSAVE("DIVS")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D
. D MAIN
Q
MAIN ;
N RUNDT,DATA
U IO
S RUNDT=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_(1700+$E(DT,1,3))
D LOCTL(.DATA,.DIVMAP)
D SHOLOCTL(.DATA,.DIVMAP,RUNDT)
D CLEANUP
D ^%ZISC
Q
;
SELECT(DM) ; Allow selection of one or all from division
N DIC,DUOUT,DTOUT,X,Y
S DIC="^DIC(4,",DIC(0)="AEQMZ"
S DIC("S")="I $D(DM(""IN"",+Y))"
S DIC("A")="Select Division or Return for All: "
D ^DIC
I $D(DUOUT)!$D(DTOUT) Q 0
Q +Y
;
LOCTL(DATA,DIVMAP) ; Build an array that sorts locations with t&ls and counts
; the number of nurses at the location and t&l
N PRSIEN,X,OUT,NAME,ZNODE,NCNT,TLE,NLDIV,IEN200,NL,NLE,SEPFLAG
S (NCNT,PRSIEN)=0
F S PRSIEN=$O(^PRSPC(PRSIEN)) Q:PRSIEN'>0 D
. S X=$$ISNURSE^PRSNUT01(PRSIEN)
. Q:'X
. S SEPFLAG=$P($G(^PRSPC(PRSIEN,1)),U,33)
. Q:SEPFLAG="Y"
. S NCNT=NCNT+1
. S IEN200=$P($G(^PRSPC(PRSIEN,200)),U)
. S ZNODE=$G(^PRSPC(PRSIEN,0))
. S TLE=$P(ZNODE,U,8)
. I TLE="" S TLE="NONE"
. S (NL,NLE,NLDIV)="NONE"
. I IEN200>0 D
.. S NL=$$PRIMLOC^PRSNUT03(IEN200)
.. S NLE=$P(NL,U,3)
.. I NL>0 D
... S NLDIV=$P(DIVMAP("NL",+NL),U,3)
.. E D
... S (NLDIV,NLE)="NONE"
. I ($G(NLDIV)'="")&($G(NLE)'="")&($G(TLE)'="") D
.. I NLDIV'="NONE",DIVS'<0,DIVS'=NLDIV Q ;NOT ALL DIVS OR NOT THE DIV WE'RE LOOKING FOR
.. I '$D(DATA(NLDIV,NLE,TLE)) S (DATA(NLDIV,NLE,TLE))=0
.. S DATA(NLDIV,NLE,TLE)=+DATA(NLDIV,NLE,TLE)+1
Q
;
SHOLOCTL(DATA,DIVMAP,RUNDT) ;
N NLD,LSTNLD,STOP,I,J
S (NLD,LSTNLD,STOP)=0
F S NLD=$O(DATA(NLD)) Q:NLD=""!STOP D
. I NLD'=LSTNLD S:LSTNLD'=0 STOP=$$ASK^PRSLIB00() S LSTNLD=NLD D HDR
. S I=""
. F S I=$O(DATA(NLD,I)) Q:I="" D
.. W !,I
.. S J=""
.. F S J=$O(DATA(NLD,I,J)) Q:J="" D
... W !,?25,$G(DATA(NLD,I,J)),?41,J
... I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() D HDR
Q
;
HDR ;
N K
W @IOF,!!!?7,"DIVISION: "
I $G(NLD)="NONE"!($G(NLD)="") D
. W NLD
E D
. W $P(DIVMAP("IN",NLD),U)," (",$P(DIVMAP("IN",NLD),U,2),")"
W ?(IOM-22),"Run Date: ",RUNDT
W !,"Location",?22,"Nurse Count",?38,"T&L Unit"
W ! F K=1:1:IOM W "-"
Q
;
BLDMAP(DIVMAP) ; BUILD A DIVISION MAP OF LOCATIONS
N DIVINFO,LIEN
S LIEN=0
F S LIEN=$O(^NURSF(211.4,LIEN)) Q:LIEN'>0 D
. S DIVINFO=$$DIV^PRSNUT03("N",LIEN)
. S DIVMAP("NL",LIEN)=DIVINFO
. S DIVMAP("IN",$P(DIVINFO,U,3))=$P(DIVINFO,U,1,2)
Q
CLEANUP ;
K DIVMAP,DATA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNUT05 3073 printed Dec 13, 2024@02:27:45 Page 2
PRSNUT05 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/5/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 ;
SHOWSU ; SHOW SYSTEM SETUP WITH DIVISIONS, NURSE LOCATIONS AND T&Ls
+1 ;
+2 NEW %ZIS,POP,IOP,DIVMAP,DIVS
+3 DO BLDMAP(.DIVMAP)
+4 SET DIVS=$$SELECT(.DIVMAP)
+5 if DIVS=0
QUIT
+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="PRSN SHOW SYSTEM SETUP REPORT"
+13 SET ZTRTN="MAIN^PRSNUT05"
+14 SET ZTSAVE("DIVMAP(")=""
+15 SET ZTSAVE("DIVS")=""
+16 DO ^%ZTLOAD
+17 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 DO MAIN
End DoDot:1
+20 QUIT
MAIN ;
+1 NEW RUNDT,DATA
+2 USE IO
+3 SET RUNDT=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_(1700+$EXTRACT(DT,1,3))
+4 DO LOCTL(.DATA,.DIVMAP)
+5 DO SHOLOCTL(.DATA,.DIVMAP,RUNDT)
+6 DO CLEANUP
+7 DO ^%ZISC
+8 QUIT
+9 ;
SELECT(DM) ; Allow selection of one or all from division
+1 NEW DIC,DUOUT,DTOUT,X,Y
+2 SET DIC="^DIC(4,"
SET DIC(0)="AEQMZ"
+3 SET DIC("S")="I $D(DM(""IN"",+Y))"
+4 SET DIC("A")="Select Division or Return for All: "
+5 DO ^DIC
+6 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT 0
+7 QUIT +Y
+8 ;
LOCTL(DATA,DIVMAP) ; Build an array that sorts locations with t&ls and counts
+1 ; the number of nurses at the location and t&l
+2 NEW PRSIEN,X,OUT,NAME,ZNODE,NCNT,TLE,NLDIV,IEN200,NL,NLE,SEPFLAG
+3 SET (NCNT,PRSIEN)=0
+4 FOR
SET PRSIEN=$ORDER(^PRSPC(PRSIEN))
if PRSIEN'>0
QUIT
Begin DoDot:1
+5 SET X=$$ISNURSE^PRSNUT01(PRSIEN)
+6 if 'X
QUIT
+7 SET SEPFLAG=$PIECE($GET(^PRSPC(PRSIEN,1)),U,33)
+8 if SEPFLAG="Y"
QUIT
+9 SET NCNT=NCNT+1
+10 SET IEN200=$PIECE($GET(^PRSPC(PRSIEN,200)),U)
+11 SET ZNODE=$GET(^PRSPC(PRSIEN,0))
+12 SET TLE=$PIECE(ZNODE,U,8)
+13 IF TLE=""
SET TLE="NONE"
+14 SET (NL,NLE,NLDIV)="NONE"
+15 IF IEN200>0
Begin DoDot:2
+16 SET NL=$$PRIMLOC^PRSNUT03(IEN200)
+17 SET NLE=$PIECE(NL,U,3)
+18 IF NL>0
Begin DoDot:3
+19 SET NLDIV=$PIECE(DIVMAP("NL",+NL),U,3)
End DoDot:3
+20 IF '$TEST
Begin DoDot:3
+21 SET (NLDIV,NLE)="NONE"
End DoDot:3
End DoDot:2
+22 IF ($GET(NLDIV)'="")&($GET(NLE)'="")&($GET(TLE)'="")
Begin DoDot:2
+23 ;NOT ALL DIVS OR NOT THE DIV WE'RE LOOKING FOR
IF NLDIV'="NONE"
IF DIVS'<0
IF DIVS'=NLDIV
QUIT
+24 IF '$DATA(DATA(NLDIV,NLE,TLE))
SET (DATA(NLDIV,NLE,TLE))=0
+25 SET DATA(NLDIV,NLE,TLE)=+DATA(NLDIV,NLE,TLE)+1
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
SHOLOCTL(DATA,DIVMAP,RUNDT) ;
+1 NEW NLD,LSTNLD,STOP,I,J
+2 SET (NLD,LSTNLD,STOP)=0
+3 FOR
SET NLD=$ORDER(DATA(NLD))
if NLD=""!STOP
QUIT
Begin DoDot:1
+4 IF NLD'=LSTNLD
if LSTNLD'=0
SET STOP=$$ASK^PRSLIB00()
SET LSTNLD=NLD
DO HDR
+5 SET I=""
+6 FOR
SET I=$ORDER(DATA(NLD,I))
if I=""
QUIT
Begin DoDot:2
+7 WRITE !,I
+8 SET J=""
+9 FOR
SET J=$ORDER(DATA(NLD,I,J))
if J=""
QUIT
Begin DoDot:3
+10 WRITE !,?25,$GET(DATA(NLD,I,J)),?41,J
+11 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
DO HDR
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
HDR ;
+1 NEW K
+2 WRITE @IOF,!!!?7,"DIVISION: "
+3 IF $GET(NLD)="NONE"!($GET(NLD)="")
Begin DoDot:1
+4 WRITE NLD
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 WRITE $PIECE(DIVMAP("IN",NLD),U)," (",$PIECE(DIVMAP("IN",NLD),U,2),")"
End DoDot:1
+7 WRITE ?(IOM-22),"Run Date: ",RUNDT
+8 WRITE !,"Location",?22,"Nurse Count",?38,"T&L Unit"
+9 WRITE !
FOR K=1:1:IOM
WRITE "-"
+10 QUIT
+11 ;
BLDMAP(DIVMAP) ; BUILD A DIVISION MAP OF LOCATIONS
+1 NEW DIVINFO,LIEN
+2 SET LIEN=0
+3 FOR
SET LIEN=$ORDER(^NURSF(211.4,LIEN))
if LIEN'>0
QUIT
Begin DoDot:1
+4 SET DIVINFO=$$DIV^PRSNUT03("N",LIEN)
+5 SET DIVMAP("NL",LIEN)=DIVINFO
+6 SET DIVMAP("IN",$PIECE(DIVINFO,U,3))=$PIECE(DIVINFO,U,1,2)
End DoDot:1
+7 QUIT
CLEANUP ;
+1 KILL DIVMAP,DATA
+2 QUIT
