PRSNUT02 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/19/2009
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038,this routine should not be modified.
Q
ACCESS(GRPS,ACCTYPE,PRSDT,MANY) ;return the user selected Group
K GRPS
;
;INPUT:
; ACCTYPE-The type of access flag, E for data entry personnel and
; A for data approval personnel
; PRSDT- date for determination of what the division access parameter
; was on that date (either T&L or Location)
; MANY- (optional) set this flag to true (1) if more than one
; group can be selected. Set the flag to (2) if you want
; all groups user has access to without any prompting.
;
;OUTPUT:
;PROCEDURE INTERACTS W/USER TO RETURN THE FOLLOWING:
;
; GRPS - array w/users selected groups subscripted
; by .01 field value (t&l external code or location pointer)
; GRPS(0) - will contain the number selected followed by either
; N,T, or E for Nurse Location, T&L unit or Error
; If piece 2 is an E then piece 3 will contain error
; description
;
; Node Definition: an Upparrow delimited string with the following:
; PEICE DEFINITION
; ===== ==============================
; 1 IEN of field value of group
; 2 IEN of Division associated with this Group
; 3 External value of division
;
; Sample Call:
;
; D ACCESS^PRSNUT02(.G,"E",DT,1)
;
; Sample Return:
;
; G(0)="3^N"
; G("1E-EAST")="1^16433^500GA"
; G("3B-EAST")="6^16433^500GA"
; G("3B-WEST")="4^16433^500GA"
;
; determine for which entities current user has access to in both T&L
; Unit File & NURS LOCATION file. Build temp list of all possible
; groups. If user has access to groups in more than one division then
; prompt for division
;
N TINDEX,LINDEX
;
; use access type parameter for appropriate indices for data entry
; or data approval personnel--TINDEX is the T&L unit file and
; LINDEX is the Nurse Location.
;
S TINDEX=$S(ACCTYPE="E":"AE",ACCTYPE="A":"AR",1:"")
S LINDEX=$S(ACCTYPE="E":"AE",ACCTYPE="A":"AA",1:"")
;
; Quit if no access specified in ACCTYP parameter
I TINDEX="" S GRPS(0)="0^E^Access Type Not Specified" Q
;
N TMPGRPS,DIVMAP,DIVGRP,TLNODIV,DIVNOPAR
D TLACC(.TMPGRPS,.DIVMAP,.DIVGRP,.TLNODIV,.DIVNOPAR,TINDEX,DUZ,PRSDT)
;
N OUT
S OUT=0
I $D(TLNODIV) D
. W !!?5,"WARNING:",!?5,"========="
. W !?5,"You have access to the following T&L unit(s), but no division"
. W !?5," has been entered for the T&L(s):"
. S TLE=""
. F S TLE=$O(TLNODIV(TLE)) Q:TLE="" D
.. W !?8,TLE
. S OUT=$$ASK^PRSLIB00(0)
I OUT S GRPS(0)="0^E^user abort" Q
;
; get locations that meet the criteria:
; 1. user has access
; 2. division access parameter matches the users access type
;
D NLACC(.TMPGRPS,.DIVMAP,.DIVGRP,.TLNODIV,.DIVNOPAR,LINDEX,DUZ,PRSDT)
;
N NDIVI
I $D(DIVNOPAR) D
. W !!,"WARNING: ",!,"========"
. W !?5,"You have access to location(s) or T&L units in the following"
. W !?5,"division(s), but the division parameter has not been set by"
. W !?5,"the package coordinator:",!
. S NDIVI=0
. F S NDIVI=$O(DIVNOPAR(NDIVI)) Q:NDIVI="" D
.. D GETS^DIQ(4,NDIVI_",",".01;99","EI","FIELDS(",,)
.. W !?7,NDIVI,?17,FIELDS(4,NDIVI_",",.01,"E"),?34,FIELDS(4,NDIVI_",",99,"E")
. S OUT=$$ASK^PRSLIB00(0)
I OUT S GRPS(0)="0^E^user abort" Q
;
;
I '$D(DIVMAP) S GRPS(0)="0^E^You have no access to T&Ls or Locations" Q
;
; count divsions user can access
;
N CNT,NDIVI
S (NDIVI,CNT)=0 F S NDIVI=$O(DIVMAP(NDIVI)) Q:NDIVI'>0 S CNT=CNT+1
;
N OUT,SELDIV S OUT=0
I CNT>1 D
. W !?5,"You have access to location(s) or T&L units in more than one division"
. N DIC,X,Y,DUOUT,DTOUT S DIC(0)="AEQMZ",DIC="^DIC(4,"
. S DIC("S")="I $P($G(DIVMAP(Y)),U,2)'="""""
. D ^DIC I $D(DUOUT)!$D(DTOUT)!(Y'>0) S OUT=1
. S SELDIV=$G(Y)
E D
. S SELDIV=$O(DIVMAP(0))
I OUT S GRPS(0)="0^E^user abort" Q
;
; prompt for location or T&L within selected division
;
N DIVPARAM
S DIVPARAM=$P($G(DIVMAP(+SELDIV)),U,2)
I "T^N"'[DIVPARAM S GRPS(0)="0^E^Division Parameter Unspecified" Q
;
N DIC,X,Y,DUOUT,DTOUT,VAUTSTR,VAUTNI,VAUTVB,OUT
S OUT=0
; select t&l unit or nurse location
I DIVPARAM="T" D
. S VAUTSTR="T&L Units",DIC="^PRST(455.5,"
E D
. S VAUTSTR="Nurse Location",DIC="^NURSF(211.4,"
S DIC(0)="AEQMZ",DIC("S")="I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y))"
I $G(MANY)=1 D
. N PRSNGR
. S VAUTNI=2,VAUTVB="PRSNGR"
. D FIRST^VAUTOMA
. S (CNT,Y)=0
. I 'PRSNGR D
.. F S Y=$O(PRSNGR(Y)) Q:Y="" D
... I $D(TMPGRPS(DIVPARAM,+SELDIV,Y)) D
.... S CNT=CNT+1
.... S GRPS($G(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$G(DIVGRP(DIVPARAM,+Y))_U_$S(DIVPARAM="N":+$G(^NURSF(211.4,+Y,0)),1:"")
. E D
.. ; all groups selected, so update output array with them
.. F S Y=$O(DIVGRP(DIVPARAM,Y)) Q:Y="" D
... I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y)) D
.... S CNT=CNT+1
.... S GRPS($G(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$G(DIVGRP(DIVPARAM,+Y))_U_$S(DIVPARAM="N":+$G(^NURSF(211.4,+Y,0)),1:"")
. S GRPS(0)=CNT_U_DIVPARAM
. I CNT=0 S GRPS(0)="0^E^Nothing Selected" Q
E D
.; automatically return all groups (no prompt)
. I $G(MANY)=2 D
.. S (CNT,Y)=0
.. F S Y=$O(DIVGRP(DIVPARAM,Y)) Q:Y="" D
... I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y)) D
.... S CNT=CNT+1
.... S GRPS($G(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$G(DIVGRP(DIVPARAM,+Y))_U_$S(DIVPARAM="N":+$G(^NURSF(211.4,+Y,0)),1:"")
.. S GRPS(0)=CNT_U_DIVPARAM
.. I CNT=0 S GRPS(0)="0^E^Nothing Selected" Q
. E D
.. D ^DIC
.. I $D(DUOUT)!$D(DTOUT)!(Y'>0) S OUT=1 Q
.. S GRPS(0)="1"_U_DIVPARAM
.. S GRPS($G(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$G(DIVGRP(DIVPARAM,+Y))_U_$S(DIVPARAM="N":+$G(^NURSF(211.4,+Y,0)),1:"")
I OUT S GRPS(0)="0^E^user abort" Q
;
Q
;
DIVACC(PRSDT,NDIVI) ; Return Nurse Access parameter for a division
;
N PPI,PPE,PARAMIEN,EFFECTPP,IEN456
S PPI=+$G(^PRST(458,"AD",PRSDT))
;
; Default to last pay period on file if none found for PRSDT
I PPI'>0 S PPI=$O(^PRST(458,9999999),-1)
;
S PPE=$P($G(^PRST(458,PPI,0)),U)
S IEN456=$O(^PRST(456,"B",NDIVI,0))
;
Q:IEN456="" ""
;
S EFFECTPP=$O(^PRST(456,IEN456,1,"C",PPE_"A"),-1)
;
Q:EFFECTPP="" ""
;
Q $O(^PRST(456,IEN456,1,"C",EFFECTPP,0))_"^"_EFFECTPP
;
Q
TLACC(TG,DM,DG,TND,DNP,INDEX,IEN200,PRSDT) ;get T&Ls user has access to.
; The T&L's division must also have access parameter set to T&L unit.
; Also return T&L's with no division or T&L's with a division (but the
; division parameter isn't set) for warning messages but don't add
; these to selection list.
;
; OUTPUT:
; TG: temporary array of groups user has access to
; DM: Division Map-array of divisions
; DG: Division group array
; TND: T&L with no divisions array
; DNP: divisions with no parameter array
;
; Example of array
;
; TG("N",500,5)="5-NORTH"
; TG("N",16433,6)="3B-EAST"
; TG("N",16436,1)="1E-EAST"
; TG("T",500,261)=112
; TG("T",16433,1)=221
;
; Example of DM array:
; 0 node - total divisions ^ access param set ^ access param not set
; other nodes - (IEN file 4)="Station number" (field #99)
;
; DM(0)=2
; DM(16433)="500GA^T&L"
; DM(16436)="500GD^NL"
;
N TLI,FIELDS,TLE,NDIVACC,NDIVI
;
S DM(0)="0^0^0"
S TLI=""
F S TLI=$O(^PRST(455.5,INDEX,IEN200,TLI)) Q:TLI="" D
. D GETS^DIQ(455.5,TLI_",",".01;20.5","IE","FIELDS(",,)
. S TLE=$G(FIELDS(455.5,TLI_",",.01,"E"))
. S NDIVI=$G(FIELDS(455.5,TLI_",",20.5,"I"))
. D GETS^DIQ(4,NDIVI_",",".01;99","EI","FIELDS(",,)
.;
. I NDIVI="" S TND(TLE)="" Q
.;
.; Get date sensitive access parameter for POC entry/approval
.; using pay period of PRSDT to find it in the Parameter file
.;
. S NDIVACC=$P($$DIVACC(PRSDT,NDIVI),U)
.;
.;
.; division access should be T&L Unit because we are looking
.; at what T&L units this user is assigned to
.;
. I NDIVACC'="T" Q
.;
. S TG("T",NDIVI,TLI)=TLE
. S DM(NDIVI)=FIELDS(4,NDIVI_",",99,"E")_U_NDIVACC
. S DG("T",TLI)=NDIVI_U_FIELDS(4,NDIVI_",",99,"E")
K FIELDS
Q
;
;
NLACC(TG,DM,DG,NND,DNP,INDEX,IEN200,PRSDT) ;
;
; SEE DOCUMENTATION IN TLACC above for INPUT/OUPUT vars. The difference
; is this finds and returns access to locations instead of T&Ls.
;
N LOCI,FIELDS,NDIVI,LOCE,NDIVACC,NURSLOC
S LOCI=0
F S LOCI=$O(^NURSF(211.4,INDEX,IEN200,LOCI)) Q:LOCI'>0 D
.;
. D GETS^DIQ(211.4,LOCI_",",".01;.02","IE","FIELDS(",,)
.;
. S LOCE=$G(FIELDS(211.4,LOCI_",",.01,"E"))
. S NDIVI=$G(FIELDS(211.4,LOCI_",",.02,"I"))
.;
. S NURSLOC=+$$GET1^DIQ(44,+$G(^NURSF(211.4,LOCI,0)),3,"I")
. D GETS^DIQ(4,NURSLOC_",",".01;99","EI","FIELDS(",,)
.;
. I NDIVI="" S NND(LOCE)="" Q
. S NDIVACC=$P($$DIVACC(PRSDT,NURSLOC),U)
.;
. I NDIVACC="" S DNP(NURSLOC)="" Q
.;
.; division access should be by Nursing Location-we are looking
.; at what Nurse locations this user is assigned to
.;
. I NDIVACC'="N" Q
.;
. S DM(NURSLOC)=FIELDS(4,NURSLOC_",",99,"E")_U_NDIVACC
. S TG("N",NURSLOC,LOCI)=LOCE
. S DG("N",LOCI)=NURSLOC_U_FIELDS(4,NURSLOC_",",99,"E")
K FIELDS
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNUT02 9466 printed Dec 13, 2024@02:27:42 Page 2
PRSNUT02 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/19/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
ACCESS(GRPS,ACCTYPE,PRSDT,MANY) ;return the user selected Group
+1 KILL GRPS
+2 ;
+3 ;INPUT:
+4 ; ACCTYPE-The type of access flag, E for data entry personnel and
+5 ; A for data approval personnel
+6 ; PRSDT- date for determination of what the division access parameter
+7 ; was on that date (either T&L or Location)
+8 ; MANY- (optional) set this flag to true (1) if more than one
+9 ; group can be selected. Set the flag to (2) if you want
+10 ; all groups user has access to without any prompting.
+11 ;
+12 ;OUTPUT:
+13 ;PROCEDURE INTERACTS W/USER TO RETURN THE FOLLOWING:
+14 ;
+15 ; GRPS - array w/users selected groups subscripted
+16 ; by .01 field value (t&l external code or location pointer)
+17 ; GRPS(0) - will contain the number selected followed by either
+18 ; N,T, or E for Nurse Location, T&L unit or Error
+19 ; If piece 2 is an E then piece 3 will contain error
+20 ; description
+21 ;
+22 ; Node Definition: an Upparrow delimited string with the following:
+23 ; PEICE DEFINITION
+24 ; ===== ==============================
+25 ; 1 IEN of field value of group
+26 ; 2 IEN of Division associated with this Group
+27 ; 3 External value of division
+28 ;
+29 ; Sample Call:
+30 ;
+31 ; D ACCESS^PRSNUT02(.G,"E",DT,1)
+32 ;
+33 ; Sample Return:
+34 ;
+35 ; G(0)="3^N"
+36 ; G("1E-EAST")="1^16433^500GA"
+37 ; G("3B-EAST")="6^16433^500GA"
+38 ; G("3B-WEST")="4^16433^500GA"
+39 ;
+40 ; determine for which entities current user has access to in both T&L
+41 ; Unit File & NURS LOCATION file. Build temp list of all possible
+42 ; groups. If user has access to groups in more than one division then
+43 ; prompt for division
+44 ;
+45 NEW TINDEX,LINDEX
+46 ;
+47 ; use access type parameter for appropriate indices for data entry
+48 ; or data approval personnel--TINDEX is the T&L unit file and
+49 ; LINDEX is the Nurse Location.
+50 ;
+51 SET TINDEX=$SELECT(ACCTYPE="E":"AE",ACCTYPE="A":"AR",1:"")
+52 SET LINDEX=$SELECT(ACCTYPE="E":"AE",ACCTYPE="A":"AA",1:"")
+53 ;
+54 ; Quit if no access specified in ACCTYP parameter
+55 IF TINDEX=""
SET GRPS(0)="0^E^Access Type Not Specified"
QUIT
+56 ;
+57 NEW TMPGRPS,DIVMAP,DIVGRP,TLNODIV,DIVNOPAR
+58 DO TLACC(.TMPGRPS,.DIVMAP,.DIVGRP,.TLNODIV,.DIVNOPAR,TINDEX,DUZ,PRSDT)
+59 ;
+60 NEW OUT
+61 SET OUT=0
+62 IF $DATA(TLNODIV)
Begin DoDot:1
+63 WRITE !!?5,"WARNING:",!?5,"========="
+64 WRITE !?5,"You have access to the following T&L unit(s), but no division"
+65 WRITE !?5," has been entered for the T&L(s):"
+66 SET TLE=""
+67 FOR
SET TLE=$ORDER(TLNODIV(TLE))
if TLE=""
QUIT
Begin DoDot:2
+68 WRITE !?8,TLE
End DoDot:2
+69 SET OUT=$$ASK^PRSLIB00(0)
End DoDot:1
+70 IF OUT
SET GRPS(0)="0^E^user abort"
QUIT
+71 ;
+72 ; get locations that meet the criteria:
+73 ; 1. user has access
+74 ; 2. division access parameter matches the users access type
+75 ;
+76 DO NLACC(.TMPGRPS,.DIVMAP,.DIVGRP,.TLNODIV,.DIVNOPAR,LINDEX,DUZ,PRSDT)
+77 ;
+78 NEW NDIVI
+79 IF $DATA(DIVNOPAR)
Begin DoDot:1
+80 WRITE !!,"WARNING: ",!,"========"
+81 WRITE !?5,"You have access to location(s) or T&L units in the following"
+82 WRITE !?5,"division(s), but the division parameter has not been set by"
+83 WRITE !?5,"the package coordinator:",!
+84 SET NDIVI=0
+85 FOR
SET NDIVI=$ORDER(DIVNOPAR(NDIVI))
if NDIVI=""
QUIT
Begin DoDot:2
+86 DO GETS^DIQ(4,NDIVI_",",".01;99","EI","FIELDS(",,)
+87 WRITE !?7,NDIVI,?17,FIELDS(4,NDIVI_",",.01,"E"),?34,FIELDS(4,NDIVI_",",99,"E")
End DoDot:2
+88 SET OUT=$$ASK^PRSLIB00(0)
End DoDot:1
+89 IF OUT
SET GRPS(0)="0^E^user abort"
QUIT
+90 ;
+91 ;
+92 IF '$DATA(DIVMAP)
SET GRPS(0)="0^E^You have no access to T&Ls or Locations"
QUIT
+93 ;
+94 ; count divsions user can access
+95 ;
+96 NEW CNT,NDIVI
+97 SET (NDIVI,CNT)=0
FOR
SET NDIVI=$ORDER(DIVMAP(NDIVI))
if NDIVI'>0
QUIT
SET CNT=CNT+1
+98 ;
+99 NEW OUT,SELDIV
SET OUT=0
+100 IF CNT>1
Begin DoDot:1
+101 WRITE !?5,"You have access to location(s) or T&L units in more than one division"
+102 NEW DIC,X,Y,DUOUT,DTOUT
SET DIC(0)="AEQMZ"
SET DIC="^DIC(4,"
+103 SET DIC("S")="I $P($G(DIVMAP(Y)),U,2)'="""""
+104 DO ^DIC
IF $DATA(DUOUT)!$DATA(DTOUT)!(Y'>0)
SET OUT=1
+105 SET SELDIV=$GET(Y)
End DoDot:1
+106 IF '$TEST
Begin DoDot:1
+107 SET SELDIV=$ORDER(DIVMAP(0))
End DoDot:1
+108 IF OUT
SET GRPS(0)="0^E^user abort"
QUIT
+109 ;
+110 ; prompt for location or T&L within selected division
+111 ;
+112 NEW DIVPARAM
+113 SET DIVPARAM=$PIECE($GET(DIVMAP(+SELDIV)),U,2)
+114 IF "T^N"'[DIVPARAM
SET GRPS(0)="0^E^Division Parameter Unspecified"
QUIT
+115 ;
+116 NEW DIC,X,Y,DUOUT,DTOUT,VAUTSTR,VAUTNI,VAUTVB,OUT
+117 SET OUT=0
+118 ; select t&l unit or nurse location
+119 IF DIVPARAM="T"
Begin DoDot:1
+120 SET VAUTSTR="T&L Units"
SET DIC="^PRST(455.5,"
End DoDot:1
+121 IF '$TEST
Begin DoDot:1
+122 SET VAUTSTR="Nurse Location"
SET DIC="^NURSF(211.4,"
End DoDot:1
+123 SET DIC(0)="AEQMZ"
SET DIC("S")="I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y))"
+124 IF $GET(MANY)=1
Begin DoDot:1
+125 NEW PRSNGR
+126 SET VAUTNI=2
SET VAUTVB="PRSNGR"
+127 DO FIRST^VAUTOMA
+128 SET (CNT,Y)=0
+129 IF 'PRSNGR
Begin DoDot:2
+130 FOR
SET Y=$ORDER(PRSNGR(Y))
if Y=""
QUIT
Begin DoDot:3
+131 IF $DATA(TMPGRPS(DIVPARAM,+SELDIV,Y))
Begin DoDot:4
+132 SET CNT=CNT+1
+133 SET GRPS($GET(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$GET(DIVGRP(DIVPARAM,+Y))_U_$SELECT(DIVPARAM="N":+$GET(^NURSF(211.4,+Y,0)),1:"")
End DoDot:4
End DoDot:3
End DoDot:2
+134 IF '$TEST
Begin DoDot:2
+135 ; all groups selected, so update output array with them
+136 FOR
SET Y=$ORDER(DIVGRP(DIVPARAM,Y))
if Y=""
QUIT
Begin DoDot:3
+137 IF $DATA(TMPGRPS(DIVPARAM,+SELDIV,+Y))
Begin DoDot:4
+138 SET CNT=CNT+1
+139 SET GRPS($GET(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$GET(DIVGRP(DIVPARAM,+Y))_U_$SELECT(DIVPARAM="N":+$GET(^NURSF(211.4,+Y,0)),1:"")
End DoDot:4
End DoDot:3
End DoDot:2
+140 SET GRPS(0)=CNT_U_DIVPARAM
+141 IF CNT=0
SET GRPS(0)="0^E^Nothing Selected"
QUIT
End DoDot:1
+142 IF '$TEST
Begin DoDot:1
+143 ; automatically return all groups (no prompt)
+144 IF $GET(MANY)=2
Begin DoDot:2
+145 SET (CNT,Y)=0
+146 FOR
SET Y=$ORDER(DIVGRP(DIVPARAM,Y))
if Y=""
QUIT
Begin DoDot:3
+147 IF $DATA(TMPGRPS(DIVPARAM,+SELDIV,+Y))
Begin DoDot:4
+148 SET CNT=CNT+1
+149 SET GRPS($GET(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$GET(DIVGRP(DIVPARAM,+Y))_U_$SELECT(DIVPARAM="N":+$GET(^NURSF(211.4,+Y,0)),1:"")
End DoDot:4
End DoDot:3
+150 SET GRPS(0)=CNT_U_DIVPARAM
+151 IF CNT=0
SET GRPS(0)="0^E^Nothing Selected"
QUIT
End DoDot:2
+152 IF '$TEST
Begin DoDot:2
+153 DO ^DIC
+154 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y'>0)
SET OUT=1
QUIT
+155 SET GRPS(0)="1"_U_DIVPARAM
+156 SET GRPS($GET(TMPGRPS(DIVPARAM,+SELDIV,+Y)))=+Y_U_$GET(DIVGRP(DIVPARAM,+Y))_U_$SELECT(DIVPARAM="N":+$GET(^NURSF(211.4,+Y,0)),1:"")
End DoDot:2
End DoDot:1
+157 IF OUT
SET GRPS(0)="0^E^user abort"
QUIT
+158 ;
+159 QUIT
+160 ;
DIVACC(PRSDT,NDIVI) ; Return Nurse Access parameter for a division
+1 ;
+2 NEW PPI,PPE,PARAMIEN,EFFECTPP,IEN456
+3 SET PPI=+$GET(^PRST(458,"AD",PRSDT))
+4 ;
+5 ; Default to last pay period on file if none found for PRSDT
+6 IF PPI'>0
SET PPI=$ORDER(^PRST(458,9999999),-1)
+7 ;
+8 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U)
+9 SET IEN456=$ORDER(^PRST(456,"B",NDIVI,0))
+10 ;
+11 if IEN456=""
QUIT ""
+12 ;
+13 SET EFFECTPP=$ORDER(^PRST(456,IEN456,1,"C",PPE_"A"),-1)
+14 ;
+15 if EFFECTPP=""
QUIT ""
+16 ;
+17 QUIT $ORDER(^PRST(456,IEN456,1,"C",EFFECTPP,0))_"^"_EFFECTPP
+18 ;
+19 QUIT
TLACC(TG,DM,DG,TND,DNP,INDEX,IEN200,PRSDT) ;get T&Ls user has access to.
+1 ; The T&L's division must also have access parameter set to T&L unit.
+2 ; Also return T&L's with no division or T&L's with a division (but the
+3 ; division parameter isn't set) for warning messages but don't add
+4 ; these to selection list.
+5 ;
+6 ; OUTPUT:
+7 ; TG: temporary array of groups user has access to
+8 ; DM: Division Map-array of divisions
+9 ; DG: Division group array
+10 ; TND: T&L with no divisions array
+11 ; DNP: divisions with no parameter array
+12 ;
+13 ; Example of array
+14 ;
+15 ; TG("N",500,5)="5-NORTH"
+16 ; TG("N",16433,6)="3B-EAST"
+17 ; TG("N",16436,1)="1E-EAST"
+18 ; TG("T",500,261)=112
+19 ; TG("T",16433,1)=221
+20 ;
+21 ; Example of DM array:
+22 ; 0 node - total divisions ^ access param set ^ access param not set
+23 ; other nodes - (IEN file 4)="Station number" (field #99)
+24 ;
+25 ; DM(0)=2
+26 ; DM(16433)="500GA^T&L"
+27 ; DM(16436)="500GD^NL"
+28 ;
+29 NEW TLI,FIELDS,TLE,NDIVACC,NDIVI
+30 ;
+31 SET DM(0)="0^0^0"
+32 SET TLI=""
+33 FOR
SET TLI=$ORDER(^PRST(455.5,INDEX,IEN200,TLI))
if TLI=""
QUIT
Begin DoDot:1
+34 DO GETS^DIQ(455.5,TLI_",",".01;20.5","IE","FIELDS(",,)
+35 SET TLE=$GET(FIELDS(455.5,TLI_",",.01,"E"))
+36 SET NDIVI=$GET(FIELDS(455.5,TLI_",",20.5,"I"))
+37 DO GETS^DIQ(4,NDIVI_",",".01;99","EI","FIELDS(",,)
+38 ;
+39 IF NDIVI=""
SET TND(TLE)=""
QUIT
+40 ;
+41 ; Get date sensitive access parameter for POC entry/approval
+42 ; using pay period of PRSDT to find it in the Parameter file
+43 ;
+44 SET NDIVACC=$PIECE($$DIVACC(PRSDT,NDIVI),U)
+45 ;
+46 ;
+47 ; division access should be T&L Unit because we are looking
+48 ; at what T&L units this user is assigned to
+49 ;
+50 IF NDIVACC'="T"
QUIT
+51 ;
+52 SET TG("T",NDIVI,TLI)=TLE
+53 SET DM(NDIVI)=FIELDS(4,NDIVI_",",99,"E")_U_NDIVACC
+54 SET DG("T",TLI)=NDIVI_U_FIELDS(4,NDIVI_",",99,"E")
End DoDot:1
+55 KILL FIELDS
+56 QUIT
+57 ;
+58 ;
NLACC(TG,DM,DG,NND,DNP,INDEX,IEN200,PRSDT) ;
+1 ;
+2 ; SEE DOCUMENTATION IN TLACC above for INPUT/OUPUT vars. The difference
+3 ; is this finds and returns access to locations instead of T&Ls.
+4 ;
+5 NEW LOCI,FIELDS,NDIVI,LOCE,NDIVACC,NURSLOC
+6 SET LOCI=0
+7 FOR
SET LOCI=$ORDER(^NURSF(211.4,INDEX,IEN200,LOCI))
if LOCI'>0
QUIT
Begin DoDot:1
+8 ;
+9 DO GETS^DIQ(211.4,LOCI_",",".01;.02","IE","FIELDS(",,)
+10 ;
+11 SET LOCE=$GET(FIELDS(211.4,LOCI_",",.01,"E"))
+12 SET NDIVI=$GET(FIELDS(211.4,LOCI_",",.02,"I"))
+13 ;
+14 SET NURSLOC=+$$GET1^DIQ(44,+$GET(^NURSF(211.4,LOCI,0)),3,"I")
+15 DO GETS^DIQ(4,NURSLOC_",",".01;99","EI","FIELDS(",,)
+16 ;
+17 IF NDIVI=""
SET NND(LOCE)=""
QUIT
+18 SET NDIVACC=$PIECE($$DIVACC(PRSDT,NURSLOC),U)
+19 ;
+20 IF NDIVACC=""
SET DNP(NURSLOC)=""
QUIT
+21 ;
+22 ; division access should be by Nursing Location-we are looking
+23 ; at what Nurse locations this user is assigned to
+24 ;
+25 IF NDIVACC'="N"
QUIT
+26 ;
+27 SET DM(NURSLOC)=FIELDS(4,NURSLOC_",",99,"E")_U_NDIVACC
+28 SET TG("N",NURSLOC,LOCI)=LOCE
+29 SET DG("N",LOCI)=NURSLOC_U_FIELDS(4,NURSLOC_",",99,"E")
End DoDot:1
+30 KILL FIELDS
+31 QUIT
+32 ;
