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

PRSNUT01.m

Go to the documentation of this file.
  1. PRSNUT01 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/5/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. GETCODES(PRSIEN) ;function returns the following codes from file 450
  1. ; Cost Center (CST)
  1. ; Budget Object Code (BOC)
  1. ; Assignment Code (ASN)
  1. ; Occupation Series Code (OCC)
  1. ;
  1. N IENS,BOC,BOCE,OCC,ASN,CST,FIELDS,ASNE,CSTE,OCCE
  1. S IENS=PRSIEN_","
  1. D GETS^DIQ(450,IENS,"3;15.5;17;18","IE","FIELDS(",,)
  1. S BOC=$G(FIELDS(450,IENS,18,"I"))
  1. S OCC=$G(FIELDS(450,IENS,15.5,"I"))
  1. S ASN=$G(FIELDS(450,IENS,3,"I"))
  1. S CST=$G(FIELDS(450,IENS,17,"I"))
  1. S BOCE=$G(FIELDS(450,IENS,18,"E"))
  1. S OCCE=$G(FIELDS(450,IENS,15.5,"E"))
  1. S ASNE=$G(FIELDS(450,IENS,3,"E"))
  1. S CSTE=$G(FIELDS(450,IENS,17,"E"))
  1. Q BOC_U_OCC_U_ASN_U_CST_U_BOCE_U_OCCE_U_ASNE_U_CSTE
  1. ;
  1. GETDEG(PRSIEN) ;function returns degree and year of degree
  1. ;
  1. N IENS,DEGREE,YEAR,FIELDS
  1. S IENS=PRSIEN_","
  1. D GETS^DIQ(450,IENS,"10;47","IE","FIELDS(",,)
  1. S DEGREE=$G(FIELDS(450,IENS,10,"E"))
  1. S YEAR=$G(FIELDS(450,IENS,47,"I"))
  1. Q DEGREE_U_YEAR
  1. ;
  1. ISNURSE(PRSIEN) ;Return True if employee is a nurse
  1. ;
  1. ;Lookup employees values in 450 for the following:
  1. ; Cost Center (CST)
  1. ; Budget Object Code (BOC)
  1. ; Assignment Code (ASN)
  1. ; Occupation Series Code (OCC)
  1. ;Determine whether they are a nurse by matching them to one of the
  1. ;entries in the Nurse Role file
  1. ;
  1. ;
  1. N BOC,CST,OCC,ASN,CODES,KEY
  1. N NODE0,ISNURSE,FIELDS,IENS
  1. S ISNURSE=0
  1. Q:PRSIEN'>0 ISNURSE
  1. S CODES=$$GETCODES(PRSIEN)
  1. S BOC=$P(CODES,U)
  1. S OCC=$P(CODES,U,2)
  1. S ASN=$P(CODES,U,3)
  1. S CST=$P(CODES,U,4)
  1. ;
  1. ; lookup on B index in 451.1 for exact or wildcard matches
  1. ;
  1. ; the wildcards (*) designate that an employee can have any value
  1. ; for that entity as long as the other entities match an entry in the
  1. ; table and they are considered a nurse.
  1. ;
  1. ; the .01 in that file is a key with cost center, budget object code,
  1. ; occupation series and assignment code.
  1. S KEY="* "_BOC_" "_OCC_" "_ASN
  1. I $D(^PRSN(451.1,"B",KEY)) D NURSTYP Q ISNURSE
  1. S KEY="* "_BOC_" "_OCC_" *"
  1. I $D(^PRSN(451.1,"B",KEY)) D NURSTYP Q ISNURSE
  1. S KEY=CST_" "_BOC_" "_OCC_" *"
  1. I $D(^PRSN(451.1,"B",KEY)) D NURSTYP Q ISNURSE
  1. S KEY=CST_" "_BOC_" "_OCC_" "_ASN
  1. I $D(^PRSN(451.1,"B",KEY)) D NURSTYP Q ISNURSE
  1. Q ISNURSE
  1. NURSTYP ;
  1. N IEN
  1. S IEN=$O(^PRSN(451.1,"B",KEY,0))
  1. S ISNURSE="1^"_$P($G(^PRSN(451.1,IEN,0)),U,2,4)
  1. Q
  1. ACTIVLOC(ACTLOC,PRSDT) ; return list of active locations for a given date
  1. ;INPUT:
  1. ; PRSDT-optional fileman date. If no date is passed then today
  1. ; is assumed.
  1. ;OUTPUT:
  1. ; ACTLOC-array of nursing locations that were active on the input
  1. ; fileman date
  1. ; output array is subscripted by Nurse Location IEN and the zero
  1. ; node contains the count of active locations
  1. ; Each node contains the following pieces.
  1. ;
  1. ; PIECE # Definition
  1. ; ------- -------------
  1. ; 1 external name of location
  1. ; 2 Institution Name
  1. ; 3 institution IEN
  1. ; 4 station number
  1. ;
  1. ;Loop through each entry in the nurse location file and check
  1. ;the index on the service date multiple to see if it was active
  1. ;
  1. I +$G(PRSDT)'>1700000!(+$G(PRSDT)'<4000000) S PRSDT=DT
  1. K ACTLOC
  1. N IEN,ACTIVE
  1. S ACTLOC(0)=0
  1. S IEN=0
  1. F S IEN=$O(^NURSF(211.4,IEN)) Q:IEN'>0 D
  1. . S ACTIVE=$$ISACTIVE(PRSDT,IEN)
  1. . I ACTIVE D
  1. .. S ACTLOC(IEN)="",ACTLOC(0)=ACTLOC(0)+1
  1. .. S ACTLOC(IEN)=$P(ACTIVE,U,2,5)
  1. Q
  1. ACTIVLST(ACTLOC,PRSDT) ; return list of active locations that are active
  1. ;for any day in a pay period in which date falls
  1. ;INPUT:
  1. ; PRSDT-optional fileman date. If no date is passed then today
  1. ; is assumed.
  1. ;OUTPUT:
  1. ; ACTLOC-array of nursing locations that were active on any day
  1. ; during the pay period associated witht the input fileman date
  1. ;
  1. ; Output array is subscripted by Nurse Location IEN and the zero
  1. ; node contains the count of active locations
  1. ; Each node contains the following pieces.
  1. ;
  1. ; PIECE # Definition
  1. ; ------- -------------
  1. ; 1 external name of location
  1. ; 2 Institution Name
  1. ; 3 institution IEN
  1. ; 4 station number
  1. ;
  1. ;Loop through each entry in the nurse location file and check
  1. ;the index on the service date multiple to see if it was active
  1. ;
  1. I +$G(PRSDT)'>1700000!(+$G(PRSDT)'<4000000) S PRSDT=DT
  1. K ACTLOC
  1. N IEN,ACTIVE
  1. S ACTLOC(0)=0
  1. S IEN=0
  1. F S IEN=$O(^NURSF(211.4,IEN)) Q:IEN'>0 D
  1. . S ACTIVE=$$ISACTPP(PRSDT,IEN)
  1. . I ACTIVE D
  1. .. S ACTLOC(IEN)="",ACTLOC(0)=ACTLOC(0)+1
  1. .. S ACTLOC(IEN)=$P(ACTIVE,U,2,6)
  1. Q
  1. ISACTIVE(PRSDT,LIEN) ;Return TRUE if location is active on date
  1. ;INPUT:
  1. ; PRSDT-FileMan date
  1. ; LIEN- nurse location internal entry number
  1. ;OUTPUT:
  1. ; function returns 5 piece string
  1. ; PIECE # Definition
  1. ; ------- -------------
  1. ; 1 0 for inactive, 1 for active
  1. ; 2 external name of location
  1. ; 3 Institution Name
  1. ; 4 institution IEN
  1. ; 5 station number
  1. ;
  1. I '$D(^NURSF(211.4,LIEN,0)) Q "-1"_U_"Undefined Location"
  1. N IENS,STATUS,DIVI,STATUS,LOCE,INSIEN,STATNUM,FIELDS
  1. I +$G(PRSDT)'>1700000!(+$G(PRSDT)'<4000000) S PRSDT=DT
  1. S PRSDT=PRSDT_".1"
  1. S PRSDT=$O(^NURSF(211.4,LIEN,7,"C",PRSDT),-1)
  1. I PRSDT="" D
  1. . S STATUS="I"
  1. E D
  1. . S STATUS=$O(^NURSF(211.4,LIEN,7,"C",PRSDT,""))
  1. S IENS=LIEN_","
  1. D GETS^DIQ(211.4,IENS_",",".01;.02","IE","FIELDS(",,)
  1. S LOCE=$G(FIELDS(211.4,IENS,.01,"E"))
  1. S DIVI=$G(FIELDS(211.4,IENS,.02,"I"))
  1. ;institution file pointer from Hospital Location
  1. ;
  1. S INSIEN=+$$GET1^DIQ(44,+$G(^NURSF(211.4,LIEN,0)),3,"I")
  1. D GETS^DIQ(4,INSIEN_",","99","E","FIELDS(",,)
  1. S STATNUM=FIELDS(4,INSIEN_",",99,"E")
  1. Q $S(STATUS="A":1,1:0)_U_LOCE_U_DIVI_U_INSIEN_U_STATNUM
  1. ;
  1. ISACTPP(PRSDT,LIEN) ;Return True if location is active for any days
  1. ; during the pay period associated with date
  1. ;INPUT:
  1. ; PRSDT-FileMan date
  1. ; LIEN- nurse location internal entry number
  1. ;OUTPUT:
  1. ; function returns 2 piece string
  1. ; 1st piece is 0 for inactive, 1 for active
  1. ; 2nd piece is external name of location
  1. ;
  1. ; UNIT TEST: F PRSI=1:1:6 W !,$$ISACTPP^PRSNUT01(3090122,PRSI)
  1. ;
  1. N PPI,I,PRSDYS,ACTIVE
  1. S PPI=$P($G(^PRST(458,"AD",PRSDT)),U)
  1. ; if date isn't in an open pay period then assume last open pay period
  1. I PPI'>0 D
  1. . S PRSDT=$O(^PRST(458,"AD",9999999),-1)
  1. . S PPI=$P($G(^PRST(458,"AD",PRSDT)),U)
  1. S PRSDYS=$G(^PRST(458,PPI,1))
  1. F I=1:1:14 S PRSDT=$P(PRSDYS,U,I) D Q:ACTIVE
  1. . S ACTIVE=$$ISACTIVE(PRSDT,LIEN)
  1. ;
  1. Q ACTIVE
  1. POCRANGE() ;Prompt user for POC date range and return start and stop dates
  1. ;
  1. ; GET START DATE
  1. N %DT,Y,X
  1. S %DT="AEP"
  1. S %DT("A")="Start Date: "
  1. ;
  1. ; Don't allow selection of dates prior to the first entry in
  1. ; the POC daily records file or a date after the last day
  1. ; of the last pay period with POC records on file
  1. ;
  1. N EPPI,LPPI,FD,LD,FIRSTDT,LASTDT
  1. S EPPI=$O(^PRSN(451,0))
  1. I EPPI'>0 Q 0_U_"No POC records on file!"
  1. S LPPI=$O(^PRSN(451,99999),-1)
  1. S LD=$P($G(^PRST(458,LPPI,1)),U,14)
  1. S Y=LD D DD^%DT S LASTDT=Y
  1. ;
  1. S FD=+$G(^PRST(458,EPPI,1))
  1. S Y=FD D DD^%DT S FIRSTDT=Y
  1. ;
  1. ;
  1. N SUCCESS,OUT,STARTDT,ENDDT,EDTE,SDTE
  1. S (SUCCESS,OUT)=0
  1. F D Q:SUCCESS!OUT
  1. .D ^%DT
  1. .I Y'>0 S OUT=1 Q
  1. .S STARTDT=Y
  1. .I STARTDT<FD D Q
  1. ..W " cannot be earlier than ",FIRSTDT,$C(7)
  1. .I STARTDT>LD D Q
  1. ..W " cannot be later than ",LASTDT,$C(7)
  1. .S SUCCESS=1
  1. Q:OUT 0
  1. ;Now reset the earliest date for end date since it cannot be before the start date
  1. S FD=STARTDT
  1. S Y=FD D DD^%DT S FIRSTDT=Y
  1. ;
  1. ;GET END DATE
  1. N %DT,Y,X
  1. S %DT="AEP"
  1. S %DT("A")="End Date: "
  1. ;
  1. ; Don't allow selection of prior to the start date
  1. ;
  1. S (SUCCESS,OUT)=0
  1. F D Q:SUCCESS!OUT
  1. .D ^%DT
  1. .I Y'>0 S OUT=1 Q
  1. .S ENDDT=Y
  1. .I ENDDT<FD D Q
  1. ..W " cannot be earlier than ",FIRSTDT,$C(7)
  1. .I ENDDT>LD D Q
  1. ..W " cannot be later than ",LASTDT,$C(7)
  1. .S SUCCESS=1
  1. Q:OUT 0
  1. S Y=STARTDT D DD^%DT S SDTE=Y
  1. S Y=ENDDT D DD^%DT S EDTE=Y
  1. Q STARTDT_U_ENDDT_U_SDTE_U_EDTE