- PRSNUT01 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/5/2009
- ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ;
- GETCODES(PRSIEN) ;function returns the following codes from file 450
- ; Cost Center (CST)
- ; Budget Object Code (BOC)
- ; Assignment Code (ASN)
- ; Occupation Series Code (OCC)
- ;
- N IENS,BOC,BOCE,OCC,ASN,CST,FIELDS,ASNE,CSTE,OCCE
- S IENS=PRSIEN_","
- D GETS^DIQ(450,IENS,"3;15.5;17;18","IE","FIELDS(",,)
- S BOC=$G(FIELDS(450,IENS,18,"I"))
- S OCC=$G(FIELDS(450,IENS,15.5,"I"))
- S ASN=$G(FIELDS(450,IENS,3,"I"))
- S CST=$G(FIELDS(450,IENS,17,"I"))
- S BOCE=$G(FIELDS(450,IENS,18,"E"))
- S OCCE=$G(FIELDS(450,IENS,15.5,"E"))
- S ASNE=$G(FIELDS(450,IENS,3,"E"))
- S CSTE=$G(FIELDS(450,IENS,17,"E"))
- Q BOC_U_OCC_U_ASN_U_CST_U_BOCE_U_OCCE_U_ASNE_U_CSTE
- ;
- GETDEG(PRSIEN) ;function returns degree and year of degree
- ;
- N IENS,DEGREE,YEAR,FIELDS
- S IENS=PRSIEN_","
- D GETS^DIQ(450,IENS,"10;47","IE","FIELDS(",,)
- S DEGREE=$G(FIELDS(450,IENS,10,"E"))
- S YEAR=$G(FIELDS(450,IENS,47,"I"))
- Q DEGREE_U_YEAR
- ;
- ISNURSE(PRSIEN) ;Return True if employee is a nurse
- ;
- ;Lookup employees values in 450 for the following:
- ; Cost Center (CST)
- ; Budget Object Code (BOC)
- ; Assignment Code (ASN)
- ; Occupation Series Code (OCC)
- ;Determine whether they are a nurse by matching them to one of the
- ;entries in the Nurse Role file
- ;
- ;
- N BOC,CST,OCC,ASN,CODES,KEY
- N NODE0,ISNURSE,FIELDS,IENS
- S ISNURSE=0
- Q:PRSIEN'>0 ISNURSE
- S CODES=$$GETCODES(PRSIEN)
- S BOC=$P(CODES,U)
- S OCC=$P(CODES,U,2)
- S ASN=$P(CODES,U,3)
- S CST=$P(CODES,U,4)
- ;
- ; lookup on B index in 451.1 for exact or wildcard matches
- ;
- ; the wildcards (*) designate that an employee can have any value
- ; for that entity as long as the other entities match an entry in the
- ; table and they are considered a nurse.
- ;
- ; the .01 in that file is a key with cost center, budget object code,
- ; occupation series and assignment code.
- S KEY="* "_BOC_" "_OCC_" "_ASN
- I $D(^PRSN(451.1,"B",KEY)) D NURSTYP Q ISNURSE
- S KEY="* "_BOC_" "_OCC_" *"
- I $D(^PRSN(451.1,"B",KEY)) D NURSTYP Q ISNURSE
- S KEY=CST_" "_BOC_" "_OCC_" *"
- I $D(^PRSN(451.1,"B",KEY)) D NURSTYP Q ISNURSE
- S KEY=CST_" "_BOC_" "_OCC_" "_ASN
- I $D(^PRSN(451.1,"B",KEY)) D NURSTYP Q ISNURSE
- Q ISNURSE
- NURSTYP ;
- N IEN
- S IEN=$O(^PRSN(451.1,"B",KEY,0))
- S ISNURSE="1^"_$P($G(^PRSN(451.1,IEN,0)),U,2,4)
- Q
- ACTIVLOC(ACTLOC,PRSDT) ; return list of active locations for a given date
- ;INPUT:
- ; PRSDT-optional fileman date. If no date is passed then today
- ; is assumed.
- ;OUTPUT:
- ; ACTLOC-array of nursing locations that were active on the input
- ; fileman date
- ; output array is subscripted by Nurse Location IEN and the zero
- ; node contains the count of active locations
- ; Each node contains the following pieces.
- ;
- ; PIECE # Definition
- ; ------- -------------
- ; 1 external name of location
- ; 2 Institution Name
- ; 3 institution IEN
- ; 4 station number
- ;
- ;Loop through each entry in the nurse location file and check
- ;the index on the service date multiple to see if it was active
- ;
- I +$G(PRSDT)'>1700000!(+$G(PRSDT)'<4000000) S PRSDT=DT
- K ACTLOC
- N IEN,ACTIVE
- S ACTLOC(0)=0
- S IEN=0
- F S IEN=$O(^NURSF(211.4,IEN)) Q:IEN'>0 D
- . S ACTIVE=$$ISACTIVE(PRSDT,IEN)
- . I ACTIVE D
- .. S ACTLOC(IEN)="",ACTLOC(0)=ACTLOC(0)+1
- .. S ACTLOC(IEN)=$P(ACTIVE,U,2,5)
- Q
- ACTIVLST(ACTLOC,PRSDT) ; return list of active locations that are active
- ;for any day in a pay period in which date falls
- ;INPUT:
- ; PRSDT-optional fileman date. If no date is passed then today
- ; is assumed.
- ;OUTPUT:
- ; ACTLOC-array of nursing locations that were active on any day
- ; during the pay period associated witht the input fileman date
- ;
- ; Output array is subscripted by Nurse Location IEN and the zero
- ; node contains the count of active locations
- ; Each node contains the following pieces.
- ;
- ; PIECE # Definition
- ; ------- -------------
- ; 1 external name of location
- ; 2 Institution Name
- ; 3 institution IEN
- ; 4 station number
- ;
- ;Loop through each entry in the nurse location file and check
- ;the index on the service date multiple to see if it was active
- ;
- I +$G(PRSDT)'>1700000!(+$G(PRSDT)'<4000000) S PRSDT=DT
- K ACTLOC
- N IEN,ACTIVE
- S ACTLOC(0)=0
- S IEN=0
- F S IEN=$O(^NURSF(211.4,IEN)) Q:IEN'>0 D
- . S ACTIVE=$$ISACTPP(PRSDT,IEN)
- . I ACTIVE D
- .. S ACTLOC(IEN)="",ACTLOC(0)=ACTLOC(0)+1
- .. S ACTLOC(IEN)=$P(ACTIVE,U,2,6)
- Q
- ISACTIVE(PRSDT,LIEN) ;Return TRUE if location is active on date
- ;INPUT:
- ; PRSDT-FileMan date
- ; LIEN- nurse location internal entry number
- ;OUTPUT:
- ; function returns 5 piece string
- ; PIECE # Definition
- ; ------- -------------
- ; 1 0 for inactive, 1 for active
- ; 2 external name of location
- ; 3 Institution Name
- ; 4 institution IEN
- ; 5 station number
- ;
- I '$D(^NURSF(211.4,LIEN,0)) Q "-1"_U_"Undefined Location"
- N IENS,STATUS,DIVI,STATUS,LOCE,INSIEN,STATNUM,FIELDS
- I +$G(PRSDT)'>1700000!(+$G(PRSDT)'<4000000) S PRSDT=DT
- S PRSDT=PRSDT_".1"
- S PRSDT=$O(^NURSF(211.4,LIEN,7,"C",PRSDT),-1)
- I PRSDT="" D
- . S STATUS="I"
- E D
- . S STATUS=$O(^NURSF(211.4,LIEN,7,"C",PRSDT,""))
- S IENS=LIEN_","
- D GETS^DIQ(211.4,IENS_",",".01;.02","IE","FIELDS(",,)
- S LOCE=$G(FIELDS(211.4,IENS,.01,"E"))
- S DIVI=$G(FIELDS(211.4,IENS,.02,"I"))
- ;institution file pointer from Hospital Location
- ;
- S INSIEN=+$$GET1^DIQ(44,+$G(^NURSF(211.4,LIEN,0)),3,"I")
- D GETS^DIQ(4,INSIEN_",","99","E","FIELDS(",,)
- S STATNUM=FIELDS(4,INSIEN_",",99,"E")
- Q $S(STATUS="A":1,1:0)_U_LOCE_U_DIVI_U_INSIEN_U_STATNUM
- ;
- ISACTPP(PRSDT,LIEN) ;Return True if location is active for any days
- ; during the pay period associated with date
- ;INPUT:
- ; PRSDT-FileMan date
- ; LIEN- nurse location internal entry number
- ;OUTPUT:
- ; function returns 2 piece string
- ; 1st piece is 0 for inactive, 1 for active
- ; 2nd piece is external name of location
- ;
- ; UNIT TEST: F PRSI=1:1:6 W !,$$ISACTPP^PRSNUT01(3090122,PRSI)
- ;
- N PPI,I,PRSDYS,ACTIVE
- S PPI=$P($G(^PRST(458,"AD",PRSDT)),U)
- ; if date isn't in an open pay period then assume last open pay period
- I PPI'>0 D
- . S PRSDT=$O(^PRST(458,"AD",9999999),-1)
- . S PPI=$P($G(^PRST(458,"AD",PRSDT)),U)
- S PRSDYS=$G(^PRST(458,PPI,1))
- F I=1:1:14 S PRSDT=$P(PRSDYS,U,I) D Q:ACTIVE
- . S ACTIVE=$$ISACTIVE(PRSDT,LIEN)
- ;
- Q ACTIVE
- POCRANGE() ;Prompt user for POC date range and return start and stop dates
- ;
- ; GET START DATE
- N %DT,Y,X
- S %DT="AEP"
- S %DT("A")="Start Date: "
- ;
- ; Don't allow selection of dates prior to the first entry in
- ; the POC daily records file or a date after the last day
- ; of the last pay period with POC records on file
- ;
- N EPPI,LPPI,FD,LD,FIRSTDT,LASTDT
- S EPPI=$O(^PRSN(451,0))
- I EPPI'>0 Q 0_U_"No POC records on file!"
- S LPPI=$O(^PRSN(451,99999),-1)
- S LD=$P($G(^PRST(458,LPPI,1)),U,14)
- S Y=LD D DD^%DT S LASTDT=Y
- ;
- S FD=+$G(^PRST(458,EPPI,1))
- S Y=FD D DD^%DT S FIRSTDT=Y
- ;
- ;
- N SUCCESS,OUT,STARTDT,ENDDT,EDTE,SDTE
- S (SUCCESS,OUT)=0
- F D Q:SUCCESS!OUT
- .D ^%DT
- .I Y'>0 S OUT=1 Q
- .S STARTDT=Y
- .I STARTDT<FD D Q
- ..W " cannot be earlier than ",FIRSTDT,$C(7)
- .I STARTDT>LD D Q
- ..W " cannot be later than ",LASTDT,$C(7)
- .S SUCCESS=1
- Q:OUT 0
- ;Now reset the earliest date for end date since it cannot be before the start date
- S FD=STARTDT
- S Y=FD D DD^%DT S FIRSTDT=Y
- ;
- ;GET END DATE
- N %DT,Y,X
- S %DT="AEP"
- S %DT("A")="End Date: "
- ;
- ; Don't allow selection of prior to the start date
- ;
- S (SUCCESS,OUT)=0
- F D Q:SUCCESS!OUT
- .D ^%DT
- .I Y'>0 S OUT=1 Q
- .S ENDDT=Y
- .I ENDDT<FD D Q
- ..W " cannot be earlier than ",FIRSTDT,$C(7)
- .I ENDDT>LD D Q
- ..W " cannot be later than ",LASTDT,$C(7)
- .S SUCCESS=1
- Q:OUT 0
- S Y=STARTDT D DD^%DT S SDTE=Y
- S Y=ENDDT D DD^%DT S EDTE=Y
- Q STARTDT_U_ENDDT_U_SDTE_U_EDTE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNUT01 8206 printed Feb 18, 2025@23:54:13 Page 2
- PRSNUT01 ;WOIFO/JAH - Nurse Activity for VANOD Utilities;6/5/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
- +4 ;
- GETCODES(PRSIEN) ;function returns the following codes from file 450
- +1 ; Cost Center (CST)
- +2 ; Budget Object Code (BOC)
- +3 ; Assignment Code (ASN)
- +4 ; Occupation Series Code (OCC)
- +5 ;
- +6 NEW IENS,BOC,BOCE,OCC,ASN,CST,FIELDS,ASNE,CSTE,OCCE
- +7 SET IENS=PRSIEN_","
- +8 DO GETS^DIQ(450,IENS,"3;15.5;17;18","IE","FIELDS(",,)
- +9 SET BOC=$GET(FIELDS(450,IENS,18,"I"))
- +10 SET OCC=$GET(FIELDS(450,IENS,15.5,"I"))
- +11 SET ASN=$GET(FIELDS(450,IENS,3,"I"))
- +12 SET CST=$GET(FIELDS(450,IENS,17,"I"))
- +13 SET BOCE=$GET(FIELDS(450,IENS,18,"E"))
- +14 SET OCCE=$GET(FIELDS(450,IENS,15.5,"E"))
- +15 SET ASNE=$GET(FIELDS(450,IENS,3,"E"))
- +16 SET CSTE=$GET(FIELDS(450,IENS,17,"E"))
- +17 QUIT BOC_U_OCC_U_ASN_U_CST_U_BOCE_U_OCCE_U_ASNE_U_CSTE
- +18 ;
- GETDEG(PRSIEN) ;function returns degree and year of degree
- +1 ;
- +2 NEW IENS,DEGREE,YEAR,FIELDS
- +3 SET IENS=PRSIEN_","
- +4 DO GETS^DIQ(450,IENS,"10;47","IE","FIELDS(",,)
- +5 SET DEGREE=$GET(FIELDS(450,IENS,10,"E"))
- +6 SET YEAR=$GET(FIELDS(450,IENS,47,"I"))
- +7 QUIT DEGREE_U_YEAR
- +8 ;
- ISNURSE(PRSIEN) ;Return True if employee is a nurse
- +1 ;
- +2 ;Lookup employees values in 450 for the following:
- +3 ; Cost Center (CST)
- +4 ; Budget Object Code (BOC)
- +5 ; Assignment Code (ASN)
- +6 ; Occupation Series Code (OCC)
- +7 ;Determine whether they are a nurse by matching them to one of the
- +8 ;entries in the Nurse Role file
- +9 ;
- +10 ;
- +11 NEW BOC,CST,OCC,ASN,CODES,KEY
- +12 NEW NODE0,ISNURSE,FIELDS,IENS
- +13 SET ISNURSE=0
- +14 if PRSIEN'>0
- QUIT ISNURSE
- +15 SET CODES=$$GETCODES(PRSIEN)
- +16 SET BOC=$PIECE(CODES,U)
- +17 SET OCC=$PIECE(CODES,U,2)
- +18 SET ASN=$PIECE(CODES,U,3)
- +19 SET CST=$PIECE(CODES,U,4)
- +20 ;
- +21 ; lookup on B index in 451.1 for exact or wildcard matches
- +22 ;
- +23 ; the wildcards (*) designate that an employee can have any value
- +24 ; for that entity as long as the other entities match an entry in the
- +25 ; table and they are considered a nurse.
- +26 ;
- +27 ; the .01 in that file is a key with cost center, budget object code,
- +28 ; occupation series and assignment code.
- +29 SET KEY="* "_BOC_" "_OCC_" "_ASN
- +30 IF $DATA(^PRSN(451.1,"B",KEY))
- DO NURSTYP
- QUIT ISNURSE
- +31 SET KEY="* "_BOC_" "_OCC_" *"
- +32 IF $DATA(^PRSN(451.1,"B",KEY))
- DO NURSTYP
- QUIT ISNURSE
- +33 SET KEY=CST_" "_BOC_" "_OCC_" *"
- +34 IF $DATA(^PRSN(451.1,"B",KEY))
- DO NURSTYP
- QUIT ISNURSE
- +35 SET KEY=CST_" "_BOC_" "_OCC_" "_ASN
- +36 IF $DATA(^PRSN(451.1,"B",KEY))
- DO NURSTYP
- QUIT ISNURSE
- +37 QUIT ISNURSE
- NURSTYP ;
- +1 NEW IEN
- +2 SET IEN=$ORDER(^PRSN(451.1,"B",KEY,0))
- +3 SET ISNURSE="1^"_$PIECE($GET(^PRSN(451.1,IEN,0)),U,2,4)
- +4 QUIT
- ACTIVLOC(ACTLOC,PRSDT) ; return list of active locations for a given date
- +1 ;INPUT:
- +2 ; PRSDT-optional fileman date. If no date is passed then today
- +3 ; is assumed.
- +4 ;OUTPUT:
- +5 ; ACTLOC-array of nursing locations that were active on the input
- +6 ; fileman date
- +7 ; output array is subscripted by Nurse Location IEN and the zero
- +8 ; node contains the count of active locations
- +9 ; Each node contains the following pieces.
- +10 ;
- +11 ; PIECE # Definition
- +12 ; ------- -------------
- +13 ; 1 external name of location
- +14 ; 2 Institution Name
- +15 ; 3 institution IEN
- +16 ; 4 station number
- +17 ;
- +18 ;Loop through each entry in the nurse location file and check
- +19 ;the index on the service date multiple to see if it was active
- +20 ;
- +21 IF +$GET(PRSDT)'>1700000!(+$GET(PRSDT)'<4000000)
- SET PRSDT=DT
- +22 KILL ACTLOC
- +23 NEW IEN,ACTIVE
- +24 SET ACTLOC(0)=0
- +25 SET IEN=0
- +26 FOR
- SET IEN=$ORDER(^NURSF(211.4,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +27 SET ACTIVE=$$ISACTIVE(PRSDT,IEN)
- +28 IF ACTIVE
- Begin DoDot:2
- +29 SET ACTLOC(IEN)=""
- SET ACTLOC(0)=ACTLOC(0)+1
- +30 SET ACTLOC(IEN)=$PIECE(ACTIVE,U,2,5)
- End DoDot:2
- End DoDot:1
- +31 QUIT
- ACTIVLST(ACTLOC,PRSDT) ; return list of active locations that are active
- +1 ;for any day in a pay period in which date falls
- +2 ;INPUT:
- +3 ; PRSDT-optional fileman date. If no date is passed then today
- +4 ; is assumed.
- +5 ;OUTPUT:
- +6 ; ACTLOC-array of nursing locations that were active on any day
- +7 ; during the pay period associated witht the input fileman date
- +8 ;
- +9 ; Output array is subscripted by Nurse Location IEN and the zero
- +10 ; node contains the count of active locations
- +11 ; Each node contains the following pieces.
- +12 ;
- +13 ; PIECE # Definition
- +14 ; ------- -------------
- +15 ; 1 external name of location
- +16 ; 2 Institution Name
- +17 ; 3 institution IEN
- +18 ; 4 station number
- +19 ;
- +20 ;Loop through each entry in the nurse location file and check
- +21 ;the index on the service date multiple to see if it was active
- +22 ;
- +23 IF +$GET(PRSDT)'>1700000!(+$GET(PRSDT)'<4000000)
- SET PRSDT=DT
- +24 KILL ACTLOC
- +25 NEW IEN,ACTIVE
- +26 SET ACTLOC(0)=0
- +27 SET IEN=0
- +28 FOR
- SET IEN=$ORDER(^NURSF(211.4,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +29 SET ACTIVE=$$ISACTPP(PRSDT,IEN)
- +30 IF ACTIVE
- Begin DoDot:2
- +31 SET ACTLOC(IEN)=""
- SET ACTLOC(0)=ACTLOC(0)+1
- +32 SET ACTLOC(IEN)=$PIECE(ACTIVE,U,2,6)
- End DoDot:2
- End DoDot:1
- +33 QUIT
- ISACTIVE(PRSDT,LIEN) ;Return TRUE if location is active on date
- +1 ;INPUT:
- +2 ; PRSDT-FileMan date
- +3 ; LIEN- nurse location internal entry number
- +4 ;OUTPUT:
- +5 ; function returns 5 piece string
- +6 ; PIECE # Definition
- +7 ; ------- -------------
- +8 ; 1 0 for inactive, 1 for active
- +9 ; 2 external name of location
- +10 ; 3 Institution Name
- +11 ; 4 institution IEN
- +12 ; 5 station number
- +13 ;
- +14 IF '$DATA(^NURSF(211.4,LIEN,0))
- QUIT "-1"_U_"Undefined Location"
- +15 NEW IENS,STATUS,DIVI,STATUS,LOCE,INSIEN,STATNUM,FIELDS
- +16 IF +$GET(PRSDT)'>1700000!(+$GET(PRSDT)'<4000000)
- SET PRSDT=DT
- +17 SET PRSDT=PRSDT_".1"
- +18 SET PRSDT=$ORDER(^NURSF(211.4,LIEN,7,"C",PRSDT),-1)
- +19 IF PRSDT=""
- Begin DoDot:1
- +20 SET STATUS="I"
- End DoDot:1
- +21 IF '$TEST
- Begin DoDot:1
- +22 SET STATUS=$ORDER(^NURSF(211.4,LIEN,7,"C",PRSDT,""))
- End DoDot:1
- +23 SET IENS=LIEN_","
- +24 DO GETS^DIQ(211.4,IENS_",",".01;.02","IE","FIELDS(",,)
- +25 SET LOCE=$GET(FIELDS(211.4,IENS,.01,"E"))
- +26 SET DIVI=$GET(FIELDS(211.4,IENS,.02,"I"))
- +27 ;institution file pointer from Hospital Location
- +28 ;
- +29 SET INSIEN=+$$GET1^DIQ(44,+$GET(^NURSF(211.4,LIEN,0)),3,"I")
- +30 DO GETS^DIQ(4,INSIEN_",","99","E","FIELDS(",,)
- +31 SET STATNUM=FIELDS(4,INSIEN_",",99,"E")
- +32 QUIT $SELECT(STATUS="A":1,1:0)_U_LOCE_U_DIVI_U_INSIEN_U_STATNUM
- +33 ;
- ISACTPP(PRSDT,LIEN) ;Return True if location is active for any days
- +1 ; during the pay period associated with date
- +2 ;INPUT:
- +3 ; PRSDT-FileMan date
- +4 ; LIEN- nurse location internal entry number
- +5 ;OUTPUT:
- +6 ; function returns 2 piece string
- +7 ; 1st piece is 0 for inactive, 1 for active
- +8 ; 2nd piece is external name of location
- +9 ;
- +10 ; UNIT TEST: F PRSI=1:1:6 W !,$$ISACTPP^PRSNUT01(3090122,PRSI)
- +11 ;
- +12 NEW PPI,I,PRSDYS,ACTIVE
- +13 SET PPI=$PIECE($GET(^PRST(458,"AD",PRSDT)),U)
- +14 ; if date isn't in an open pay period then assume last open pay period
- +15 IF PPI'>0
- Begin DoDot:1
- +16 SET PRSDT=$ORDER(^PRST(458,"AD",9999999),-1)
- +17 SET PPI=$PIECE($GET(^PRST(458,"AD",PRSDT)),U)
- End DoDot:1
- +18 SET PRSDYS=$GET(^PRST(458,PPI,1))
- +19 FOR I=1:1:14
- SET PRSDT=$PIECE(PRSDYS,U,I)
- Begin DoDot:1
- +20 SET ACTIVE=$$ISACTIVE(PRSDT,LIEN)
- End DoDot:1
- if ACTIVE
- QUIT
- +21 ;
- +22 QUIT ACTIVE
- POCRANGE() ;Prompt user for POC date range and return start and stop dates
- +1 ;
- +2 ; GET START DATE
- +3 NEW %DT,Y,X
- +4 SET %DT="AEP"
- +5 SET %DT("A")="Start Date: "
- +6 ;
- +7 ; Don't allow selection of dates prior to the first entry in
- +8 ; the POC daily records file or a date after the last day
- +9 ; of the last pay period with POC records on file
- +10 ;
- +11 NEW EPPI,LPPI,FD,LD,FIRSTDT,LASTDT
- +12 SET EPPI=$ORDER(^PRSN(451,0))
- +13 IF EPPI'>0
- QUIT 0_U_"No POC records on file!"
- +14 SET LPPI=$ORDER(^PRSN(451,99999),-1)
- +15 SET LD=$PIECE($GET(^PRST(458,LPPI,1)),U,14)
- +16 SET Y=LD
- DO DD^%DT
- SET LASTDT=Y
- +17 ;
- +18 SET FD=+$GET(^PRST(458,EPPI,1))
- +19 SET Y=FD
- DO DD^%DT
- SET FIRSTDT=Y
- +20 ;
- +21 ;
- +22 NEW SUCCESS,OUT,STARTDT,ENDDT,EDTE,SDTE
- +23 SET (SUCCESS,OUT)=0
- +24 FOR
- Begin DoDot:1
- +25 DO ^%DT
- +26 IF Y'>0
- SET OUT=1
- QUIT
- +27 SET STARTDT=Y
- +28 IF STARTDT<FD
- Begin DoDot:2
- +29 WRITE " cannot be earlier than ",FIRSTDT,$CHAR(7)
- End DoDot:2
- QUIT
- +30 IF STARTDT>LD
- Begin DoDot:2
- +31 WRITE " cannot be later than ",LASTDT,$CHAR(7)
- End DoDot:2
- QUIT
- +32 SET SUCCESS=1
- End DoDot:1
- if SUCCESS!OUT
- QUIT
- +33 if OUT
- QUIT 0
- +34 ;Now reset the earliest date for end date since it cannot be before the start date
- +35 SET FD=STARTDT
- +36 SET Y=FD
- DO DD^%DT
- SET FIRSTDT=Y
- +37 ;
- +38 ;GET END DATE
- +39 NEW %DT,Y,X
- +40 SET %DT="AEP"
- +41 SET %DT("A")="End Date: "
- +42 ;
- +43 ; Don't allow selection of prior to the start date
- +44 ;
- +45 SET (SUCCESS,OUT)=0
- +46 FOR
- Begin DoDot:1
- +47 DO ^%DT
- +48 IF Y'>0
- SET OUT=1
- QUIT
- +49 SET ENDDT=Y
- +50 IF ENDDT<FD
- Begin DoDot:2
- +51 WRITE " cannot be earlier than ",FIRSTDT,$CHAR(7)
- End DoDot:2
- QUIT
- +52 IF ENDDT>LD
- Begin DoDot:2
- +53 WRITE " cannot be later than ",LASTDT,$CHAR(7)
- End DoDot:2
- QUIT
- +54 SET SUCCESS=1
- End DoDot:1
- if SUCCESS!OUT
- QUIT
- +55 if OUT
- QUIT 0
- +56 SET Y=STARTDT
- DO DD^%DT
- SET SDTE=Y
- +57 SET Y=ENDDT
- DO DD^%DT
- SET EDTE=Y
- +58 QUIT STARTDT_U_ENDDT_U_SDTE_U_EDTE