Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSNUT02

PRSNUT02.m

Go to the documentation of this file.
  1. PRSNUT02 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/19/2009
  1. ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1. ;;Per VHA Directive 2004-038,this routine should not be modified.
  1. Q
  1. ACCESS(GRPS,ACCTYPE,PRSDT,MANY) ;return the user selected Group
  1. K GRPS
  1. ;
  1. ;INPUT:
  1. ; ACCTYPE-The type of access flag, E for data entry personnel and
  1. ; A for data approval personnel
  1. ; PRSDT- date for determination of what the division access parameter
  1. ; was on that date (either T&L or Location)
  1. ; MANY- (optional) set this flag to true (1) if more than one
  1. ; group can be selected. Set the flag to (2) if you want
  1. ; all groups user has access to without any prompting.
  1. ;
  1. ;OUTPUT:
  1. ;PROCEDURE INTERACTS W/USER TO RETURN THE FOLLOWING:
  1. ;
  1. ; GRPS - array w/users selected groups subscripted
  1. ; by .01 field value (t&l external code or location pointer)
  1. ; GRPS(0) - will contain the number selected followed by either
  1. ; N,T, or E for Nurse Location, T&L unit or Error
  1. ; If piece 2 is an E then piece 3 will contain error
  1. ; description
  1. ;
  1. ; Node Definition: an Upparrow delimited string with the following:
  1. ; PEICE DEFINITION
  1. ; ===== ==============================
  1. ; 1 IEN of field value of group
  1. ; 2 IEN of Division associated with this Group
  1. ; 3 External value of division
  1. ;
  1. ; Sample Call:
  1. ;
  1. ; D ACCESS^PRSNUT02(.G,"E",DT,1)
  1. ;
  1. ; Sample Return:
  1. ;
  1. ; G(0)="3^N"
  1. ; G("1E-EAST")="1^16433^500GA"
  1. ; G("3B-EAST")="6^16433^500GA"
  1. ; G("3B-WEST")="4^16433^500GA"
  1. ;
  1. ; determine for which entities current user has access to in both T&L
  1. ; Unit File & NURS LOCATION file. Build temp list of all possible
  1. ; groups. If user has access to groups in more than one division then
  1. ; prompt for division
  1. ;
  1. N TINDEX,LINDEX
  1. ;
  1. ; use access type parameter for appropriate indices for data entry
  1. ; or data approval personnel--TINDEX is the T&L unit file and
  1. ; LINDEX is the Nurse Location.
  1. ;
  1. S TINDEX=$S(ACCTYPE="E":"AE",ACCTYPE="A":"AR",1:"")
  1. S LINDEX=$S(ACCTYPE="E":"AE",ACCTYPE="A":"AA",1:"")
  1. ;
  1. ; Quit if no access specified in ACCTYP parameter
  1. I TINDEX="" S GRPS(0)="0^E^Access Type Not Specified" Q
  1. ;
  1. N TMPGRPS,DIVMAP,DIVGRP,TLNODIV,DIVNOPAR
  1. D TLACC(.TMPGRPS,.DIVMAP,.DIVGRP,.TLNODIV,.DIVNOPAR,TINDEX,DUZ,PRSDT)
  1. ;
  1. N OUT
  1. S OUT=0
  1. I $D(TLNODIV) D
  1. . W !!?5,"WARNING:",!?5,"========="
  1. . W !?5,"You have access to the following T&L unit(s), but no division"
  1. . W !?5," has been entered for the T&L(s):"
  1. . S TLE=""
  1. . F S TLE=$O(TLNODIV(TLE)) Q:TLE="" D
  1. .. W !?8,TLE
  1. . S OUT=$$ASK^PRSLIB00(0)
  1. I OUT S GRPS(0)="0^E^user abort" Q
  1. ;
  1. ; get locations that meet the criteria:
  1. ; 1. user has access
  1. ; 2. division access parameter matches the users access type
  1. ;
  1. D NLACC(.TMPGRPS,.DIVMAP,.DIVGRP,.TLNODIV,.DIVNOPAR,LINDEX,DUZ,PRSDT)
  1. ;
  1. N NDIVI
  1. I $D(DIVNOPAR) D
  1. . W !!,"WARNING: ",!,"========"
  1. . W !?5,"You have access to location(s) or T&L units in the following"
  1. . W !?5,"division(s), but the division parameter has not been set by"
  1. . W !?5,"the package coordinator:",!
  1. . S NDIVI=0
  1. . F S NDIVI=$O(DIVNOPAR(NDIVI)) Q:NDIVI="" D
  1. .. D GETS^DIQ(4,NDIVI_",",".01;99","EI","FIELDS(",,)
  1. .. W !?7,NDIVI,?17,FIELDS(4,NDIVI_",",.01,"E"),?34,FIELDS(4,NDIVI_",",99,"E")
  1. . S OUT=$$ASK^PRSLIB00(0)
  1. I OUT S GRPS(0)="0^E^user abort" Q
  1. ;
  1. ;
  1. I '$D(DIVMAP) S GRPS(0)="0^E^You have no access to T&Ls or Locations" Q
  1. ;
  1. ; count divsions user can access
  1. ;
  1. N CNT,NDIVI
  1. S (NDIVI,CNT)=0 F S NDIVI=$O(DIVMAP(NDIVI)) Q:NDIVI'>0 S CNT=CNT+1
  1. ;
  1. N OUT,SELDIV S OUT=0
  1. I CNT>1 D
  1. . W !?5,"You have access to location(s) or T&L units in more than one division"
  1. . N DIC,X,Y,DUOUT,DTOUT S DIC(0)="AEQMZ",DIC="^DIC(4,"
  1. . S DIC("S")="I $P($G(DIVMAP(Y)),U,2)'="""""
  1. . D ^DIC I $D(DUOUT)!$D(DTOUT)!(Y'>0) S OUT=1
  1. . S SELDIV=$G(Y)
  1. E D
  1. . S SELDIV=$O(DIVMAP(0))
  1. I OUT S GRPS(0)="0^E^user abort" Q
  1. ;
  1. ; prompt for location or T&L within selected division
  1. ;
  1. N DIVPARAM
  1. S DIVPARAM=$P($G(DIVMAP(+SELDIV)),U,2)
  1. I "T^N"'[DIVPARAM S GRPS(0)="0^E^Division Parameter Unspecified" Q
  1. ;
  1. N DIC,X,Y,DUOUT,DTOUT,VAUTSTR,VAUTNI,VAUTVB,OUT
  1. S OUT=0
  1. ; select t&l unit or nurse location
  1. I DIVPARAM="T" D
  1. . S VAUTSTR="T&L Units",DIC="^PRST(455.5,"
  1. E D
  1. . S VAUTSTR="Nurse Location",DIC="^NURSF(211.4,"
  1. S DIC(0)="AEQMZ",DIC("S")="I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y))"
  1. I $G(MANY)=1 D
  1. . N PRSNGR
  1. . S VAUTNI=2,VAUTVB="PRSNGR"
  1. . D FIRST^VAUTOMA
  1. . S (CNT,Y)=0
  1. . I 'PRSNGR D
  1. .. F S Y=$O(PRSNGR(Y)) Q:Y="" D
  1. ... I $D(TMPGRPS(DIVPARAM,+SELDIV,Y)) D
  1. .... S CNT=CNT+1
  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:"")
  1. . E D
  1. .. ; all groups selected, so update output array with them
  1. .. F S Y=$O(DIVGRP(DIVPARAM,Y)) Q:Y="" D
  1. ... I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y)) D
  1. .... S CNT=CNT+1
  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:"")
  1. . S GRPS(0)=CNT_U_DIVPARAM
  1. . I CNT=0 S GRPS(0)="0^E^Nothing Selected" Q
  1. E D
  1. .; automatically return all groups (no prompt)
  1. . I $G(MANY)=2 D
  1. .. S (CNT,Y)=0
  1. .. F S Y=$O(DIVGRP(DIVPARAM,Y)) Q:Y="" D
  1. ... I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y)) D
  1. .... S CNT=CNT+1
  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:"")
  1. .. S GRPS(0)=CNT_U_DIVPARAM
  1. .. I CNT=0 S GRPS(0)="0^E^Nothing Selected" Q
  1. . E D
  1. .. D ^DIC
  1. .. I $D(DUOUT)!$D(DTOUT)!(Y'>0) S OUT=1 Q
  1. .. S GRPS(0)="1"_U_DIVPARAM
  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:"")
  1. I OUT S GRPS(0)="0^E^user abort" Q
  1. ;
  1. Q
  1. ;
  1. DIVACC(PRSDT,NDIVI) ; Return Nurse Access parameter for a division
  1. ;
  1. N PPI,PPE,PARAMIEN,EFFECTPP,IEN456
  1. S PPI=+$G(^PRST(458,"AD",PRSDT))
  1. ;
  1. ; Default to last pay period on file if none found for PRSDT
  1. I PPI'>0 S PPI=$O(^PRST(458,9999999),-1)
  1. ;
  1. S PPE=$P($G(^PRST(458,PPI,0)),U)
  1. S IEN456=$O(^PRST(456,"B",NDIVI,0))
  1. ;
  1. Q:IEN456="" ""
  1. ;
  1. S EFFECTPP=$O(^PRST(456,IEN456,1,"C",PPE_"A"),-1)
  1. ;
  1. Q:EFFECTPP="" ""
  1. ;
  1. Q $O(^PRST(456,IEN456,1,"C",EFFECTPP,0))_"^"_EFFECTPP
  1. ;
  1. Q
  1. 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.
  1. ; Also return T&L's with no division or T&L's with a division (but the
  1. ; division parameter isn't set) for warning messages but don't add
  1. ; these to selection list.
  1. ;
  1. ; OUTPUT:
  1. ; TG: temporary array of groups user has access to
  1. ; DM: Division Map-array of divisions
  1. ; DG: Division group array
  1. ; TND: T&L with no divisions array
  1. ; DNP: divisions with no parameter array
  1. ;
  1. ; Example of array
  1. ;
  1. ; TG("N",500,5)="5-NORTH"
  1. ; TG("N",16433,6)="3B-EAST"
  1. ; TG("N",16436,1)="1E-EAST"
  1. ; TG("T",500,261)=112
  1. ; TG("T",16433,1)=221
  1. ;
  1. ; Example of DM array:
  1. ; 0 node - total divisions ^ access param set ^ access param not set
  1. ; other nodes - (IEN file 4)="Station number" (field #99)
  1. ;
  1. ; DM(0)=2
  1. ; DM(16433)="500GA^T&L"
  1. ; DM(16436)="500GD^NL"
  1. ;
  1. N TLI,FIELDS,TLE,NDIVACC,NDIVI
  1. ;
  1. S DM(0)="0^0^0"
  1. S TLI=""
  1. F S TLI=$O(^PRST(455.5,INDEX,IEN200,TLI)) Q:TLI="" D
  1. . D GETS^DIQ(455.5,TLI_",",".01;20.5","IE","FIELDS(",,)
  1. . S TLE=$G(FIELDS(455.5,TLI_",",.01,"E"))
  1. . S NDIVI=$G(FIELDS(455.5,TLI_",",20.5,"I"))
  1. . D GETS^DIQ(4,NDIVI_",",".01;99","EI","FIELDS(",,)
  1. .;
  1. . I NDIVI="" S TND(TLE)="" Q
  1. .;
  1. .; Get date sensitive access parameter for POC entry/approval
  1. .; using pay period of PRSDT to find it in the Parameter file
  1. .;
  1. . S NDIVACC=$P($$DIVACC(PRSDT,NDIVI),U)
  1. .;
  1. .;
  1. .; division access should be T&L Unit because we are looking
  1. .; at what T&L units this user is assigned to
  1. .;
  1. . I NDIVACC'="T" Q
  1. .;
  1. . S TG("T",NDIVI,TLI)=TLE
  1. . S DM(NDIVI)=FIELDS(4,NDIVI_",",99,"E")_U_NDIVACC
  1. . S DG("T",TLI)=NDIVI_U_FIELDS(4,NDIVI_",",99,"E")
  1. K FIELDS
  1. Q
  1. ;
  1. ;
  1. NLACC(TG,DM,DG,NND,DNP,INDEX,IEN200,PRSDT) ;
  1. ;
  1. ; SEE DOCUMENTATION IN TLACC above for INPUT/OUPUT vars. The difference
  1. ; is this finds and returns access to locations instead of T&Ls.
  1. ;
  1. N LOCI,FIELDS,NDIVI,LOCE,NDIVACC,NURSLOC
  1. S LOCI=0
  1. F S LOCI=$O(^NURSF(211.4,INDEX,IEN200,LOCI)) Q:LOCI'>0 D
  1. .;
  1. . D GETS^DIQ(211.4,LOCI_",",".01;.02","IE","FIELDS(",,)
  1. .;
  1. . S LOCE=$G(FIELDS(211.4,LOCI_",",.01,"E"))
  1. . S NDIVI=$G(FIELDS(211.4,LOCI_",",.02,"I"))
  1. .;
  1. . S NURSLOC=+$$GET1^DIQ(44,+$G(^NURSF(211.4,LOCI,0)),3,"I")
  1. . D GETS^DIQ(4,NURSLOC_",",".01;99","EI","FIELDS(",,)
  1. .;
  1. . I NDIVI="" S NND(LOCE)="" Q
  1. . S NDIVACC=$P($$DIVACC(PRSDT,NURSLOC),U)
  1. .;
  1. . I NDIVACC="" S DNP(NURSLOC)="" Q
  1. .;
  1. .; division access should be by Nursing Location-we are looking
  1. .; at what Nurse locations this user is assigned to
  1. .;
  1. . I NDIVACC'="N" Q
  1. .;
  1. . S DM(NURSLOC)=FIELDS(4,NURSLOC_",",99,"E")_U_NDIVACC
  1. . S TG("N",NURSLOC,LOCI)=LOCE
  1. . S DG("N",LOCI)=NURSLOC_U_FIELDS(4,NURSLOC_",",99,"E")
  1. K FIELDS
  1. Q
  1. ;