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

PRSNUT04.m

Go to the documentation of this file.
  1. PRSNUT04 ;;WOIFO/JAH - Nurse Activity for VANOD Utilities;8/25/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. ;
  1. HASACCES(IEN200,PRSIEN,ACCTYP) ;FUNCTION RETURNS TRUE if the user defined in
  1. ; parameter IEN200 has access to the Nurse defined in parameter PRSIEN
  1. ;
  1. ;INPUT:
  1. ; IEN200: accessors' internal entry number in file 200 (DUZ)
  1. ; PRSIEN: nurses' internal entry number in file 450.
  1. ; ACCTYP: 'E' OR 'A' for data Entry or Approver
  1. ;
  1. ;OUTPUT:
  1. ; HASACCES: function returns true if user has access to this nurse
  1. ;
  1. N HASACCES
  1. S HASACCES=0
  1. ;
  1. ; Get T&L unit and default location of Nurse plus division
  1. ; associated with each
  1. ;
  1. ; T&L + division
  1. N TLE,TLI,TLDIVI,TINDEX,LINDEX
  1. D GETS^DIQ(450,PRSIEN_",",7,"I","FIELDS(",,)
  1. S TLE=$G(FIELDS(450,PRSIEN_",",7,"I"))
  1. S TLI=$O(^PRST(455.5,"B",TLE,0))
  1. ;
  1. I TLI>0 D
  1. . D GETS^DIQ(455.5,TLI_",","20.5","I","FIELDS(",,)
  1. . S TLDIVI=$G(FIELDS(455.5,TLI_",",20.5,"I"))
  1. ;
  1. ; Nurses (PRSIEN) Primary Location + division
  1. N NLI,NURIE200,LINDEX,NLDIVI
  1. ;
  1. S NURIE200=+$G(^PRSPC(PRSIEN,200))
  1. S NLI=+$$PRIMLOC^PRSNUT03(NURIE200)
  1. S NLDIVI=$P($$DIV^PRSNUT03("N",+NLI),U,3)
  1. ;
  1. ; Build list of all T&Ls and Locations that (APPROVER/ENTRY PERS)
  1. ; in IEN200 has access to subscripted by group ien and division ien
  1. ;
  1. S TINDEX=$S(ACCTYP="E":"AE",ACCTYP="A":"AR",1:"")
  1. S LINDEX=$S(ACCTYP="E":"AE",ACCTYP="A":"AA",1:"")
  1. ;
  1. N TMPGRPS,DIVMAP,DIVGRP,TN,DN
  1. D TLACC^PRSNUT02(.TMPGRPS,.DIVMAP,.DIVGRP,.TN,.DN,TINDEX,IEN200,DT)
  1. D NLACC^PRSNUT02(.TMPGRPS,.DIVMAP,.DIVGRP,.TN,.DN,LINDEX,IEN200,DT)
  1. ;
  1. ; Array (returned from above calls) and shown below indicates that
  1. ; the user (IEN200) has access to both 'N' nurse locations
  1. ; and 'T' t&l units for division 16433 and division 500
  1. ; the last subscipt is the IEN of the t&l or nurse location
  1. ;
  1. ; TMPGRPS("N",16433,4)="3B-WEST 500GA"
  1. ; TMPGRPS("N",16433,5)="5-NORTH"
  1. ; TMPGRPS("T",500,222)=110
  1. ; TMPGRPS("T",500,230)=117
  1. ;
  1. ; Check to see if IEN200 (ENTRY/APPROVAL) matches access to the
  1. ; Nurses (PRSIEN) location or T&L (including correct division
  1. ; parameter for that access)
  1. ;
  1. I TLDIVI>0,$D(TMPGRPS("T",TLDIVI,TLI)) S HASACCES=1
  1. I NLDIVI>0,$D(TMPGRPS("N",NLDIVI,NLI)) S HASACCES=1
  1. ;
  1. Q HASACCES
  1. ;
  1. ;=================================================================
  1. ;
  1. PIKGROUP(GRPS,GCHOICE,MANY) ;return the groups selected by a user regardless of access
  1. K GRPS
  1. ;
  1. ;INPUT:
  1. ; GCHOICE: (optional) Flag set to T, N or null
  1. ; T: user will be prompted for T&L units
  1. ; N: user will be prompted for Nurse Locations
  1. ; null: user will be asked T&L units or locations
  1. ; MANY- (optional) set this flag to true (1) if more than one
  1. ; group can be selected
  1. ;
  1. ;OUTPUT:
  1. ;PROCEDURE INTERACTS WITH USER AND RETURNS THE FOLLWOING:
  1. ;
  1. ; GRPS - An array with the 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 internal entry number 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 PIKGROUP^PRSNUT04(.G,"T",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. ; Build temporary list of all possible groups
  1. ; If user has access to groups in more than one division then
  1. ; prompt to select a division
  1. ;
  1. ; Example of TMPGRPS array
  1. ;
  1. ; TMPGRPS("N",500,5)="5-NORTH"
  1. ; TMPGRPS("N",16433,6)="3B-EAST"
  1. ; TMPGRPS("N",16436,1)="1E-EAST"
  1. ; TMPGRPS("T",500,261)=112
  1. ; TMPGRPS("T",16433,1)=221
  1. ;
  1. ; Example of DIVMAP 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. ; DIVMAP(0)=2
  1. ; DIVMAP(16433)="500GA^T&L"
  1. ; DIVMAP(16436)="500GD^NL"
  1. ;
  1. N TLI,FIELDS,TLE,TMPGRPS,DIVMAP,LOCI,LOCE,I,DIVNOPAR,EFFECTPP,DIVPARAM
  1. N NURSLOC,SELDIV,TINDEX,TLDIVI,DIVGRP,DIVI
  1. ;
  1. S DIVMAP(0)="0^0^0"
  1. S TLI=0
  1. F S TLI=$O(^PRST(455.5,TLI)) Q:TLI'>0 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 DIVI=$G(FIELDS(455.5,TLI_",",20.5,"I"))
  1. .;
  1. . Q:DIVI=""
  1. .;
  1. . D GETS^DIQ(4,DIVI_",",".01;99","EI","FIELDS(",,)
  1. .;
  1. . S TMPGRPS("T",DIVI,TLI)=TLE
  1. . S DIVMAP(DIVI)=FIELDS(4,DIVI_",",99,"E")
  1. . S DIVGRP("T",TLI)=DIVI_U_FIELDS(4,DIVI_",",99,"E")
  1. K FIELDS
  1. ;
  1. S LOCI=0
  1. F S LOCI=$O(^NURSF(211.4,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 DIVI=$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. . Q:DIVI=""
  1. .;
  1. . S DIVMAP(NURSLOC)=FIELDS(4,NURSLOC_",",99,"E")
  1. . S TMPGRPS("N",NURSLOC,LOCI)=LOCE
  1. . S DIVGRP("N",LOCI)=NURSLOC_U_FIELDS(4,NURSLOC_",",99,"E")
  1. K FIELDS
  1. ;
  1. ;
  1. I '$D(DIVMAP) S GRPS(0)="0^E^No T&Ls or Locations found with correct division setup." Q
  1. ;
  1. ; count number of divisions with t&ls and locations
  1. ;
  1. N CNT,DIVI
  1. S (DIVI,CNT)=0 F S DIVI=$O(DIVMAP(DIVI)) Q:DIVI'>0 S CNT=CNT+1
  1. ;
  1. N OUT
  1. S OUT=0
  1. I CNT>1 D
  1. . W !?5,"Location(s) and T&L units are in more than one division"
  1. . N DIC,X,Y,DUOUT,DTOUT
  1. . S DIC(0)="AEQMZ"
  1. . S DIC="^DIC(4,"
  1. . S DIC("S")="I $D(DIVMAP(Y))"
  1. . D ^DIC
  1. . 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 user for location or T&L within selected division
  1. ;
  1. N DIR,DIRUT,X,Y
  1. I "^N^T^"'[(U_$G(GCHOICE)_U) D
  1. . S DIR(0)="S^T:T&L Units;N:Nurse Locations"
  1. . S DIR("A")="Enter Selection"
  1. . S DIR("?")="Enter whether you want to select T&L units or Locations."
  1. . D ^DIR
  1. . S DIVPARAM=Y
  1. E D
  1. . S DIVPARAM=GCHOICE
  1. I $D(DIRUT) S GRPS(0)="0^E^user abort" Q
  1. ;
  1. N DIC,X,Y,DUOUT,DTOUT,VAUTSTR,VAUTNI,VAUTVB,OUT,PRSNGR
  1. S OUT=0
  1. ; select t&l unit OR nurse location
  1. I DIVPARAM="T" D
  1. . S VAUTSTR="T&L Units"
  1. . S DIC="^PRST(455.5,"
  1. E D
  1. . S VAUTSTR="Nurse Location"
  1. . S DIC="^NURSF(211.4,"
  1. S DIC(0)="AEQMZ"
  1. S DIC("S")="I $D(TMPGRPS(DIVPARAM,+SELDIV,+Y))"
  1. I $G(MANY) D
  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. .;
  1. . S GRPS(0)=CNT_U_$E(DIVPARAM,1,1)
  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_$E(DIVPARAM,1,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. I OUT S GRPS(0)="0^E^user abort" Q
  1. ;
  1. Q
  1. ;