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 Oct 16, 2024@18:28:26 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
