- 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 Feb 18, 2025@23:54:13 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 ;