PXDATE.m

PXDATE ;SLC/PKR - Routines for dealing with dates. ;12/19/2022

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217,234**;Aug 12, 1996;Build 6

 ;;

 ;================================

EVENTDT(DEFAULT,HELP) ;Edit Event Date and Time.

 N EVENTDT,DIRUT,PROMPT

 S PROMPT="Event Date and Time"

 S EVENTDT=$$GETDT^PXDATE(-1,-1,-1,DEFAULT,PROMPT,HELP)

 I $D(DIRUT),(EVENTDT'="@") S PXCEEND=1 Q ""

 Q EVENTDT

 ;

 ;================================

FUTURE(DATE) ;Return 1 if DATE is in the future.

 I DATE>$$NOW^XLFDT Q 1

 Q 0

 ;

 ;================================

GETDT(REQTIME,BEFORE,AFTER,DEFAULT,PROMPT,HELP) ;General date/time entry

 ;REQTIME is 1 if time is required,

 ;           0 if time is optional

 ;          -1 if the date can be imprecise

 ;BEFORE  is the maximum number of days before the visit that the date

 ;        can be or -1 for no limit.

 ;AFTER   is the maximum number of days after the visit that the date

 ;        can be or -1 for no limit, except it cannot be in the future.

 ;DEFAULT is the default date/time if there is not one in the file.

 ;        The possible values are NOW or TODAY.

 N AFTERDT,BEFOREDT,DIR,VISITDT,X,Y

 S VISITDT=$P(^TMP("PXK",$J,"VST",1,0,"BEFORE"),U,1)

 S AFTERDT=$S(AFTER=-1:"NOW",1:$$FMADD^XLFDT(VISITDT,-AFTER,0,0,0))

 S BEFOREDT=$S(BEFORE=-1:"",1:$$FMADD^XLFDT(VISITDT,BEFORE,0,0,0))

 ;Setup the DIR call.

 S DIR(0)="DO^"_BEFOREDT_":"_AFTERDT_":ESP"

 S REQTIME=$G(REQTIME)

 S DIR(0)=DIR(0)_$S(REQTIME=1:"RX",REQTIME=-1:"T",REQTIME=0:"TX",1:"")

 S DIR("A")=PROMPT

 S DIR("B")=$$FMTE^XLFDT(DEFAULT,"5Z")

 I $G(HELP)'="" S DIR("??")="^"_HELP

 D ^DIR

 I X="@" S Y="@"

 I X="^" S Y=DEFAULT

 Q Y

 ;

 ;================================

ISLEAP(YEAR) ;Given a 3 digit FileMan year return 1 if it is a leap year,

 ;0 otherwise.

 S YEAR=YEAR+1700

 Q (YEAR#4=0)&'(YEAR#100=0)!(YEAR#400=0)

 ;

 ;================================

VFMDATE(X,%DT) ;Is X a valid FileMan date?

 N Y

 D ^%DT

 Q Y

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXDATE   1971     printed  Apr 09, 2024@21:30:23                                                                                                                                                                                                      Page 2

PXDATE    ;SLC/PKR - Routines for dealing with dates. ;12/19/2022

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217,234**;Aug 12, 1996;Build 6

 +2       ;;

 +3       ;================================

EVENTDT(DEFAULT,HELP) ;Edit Event Date and Time.

 +1        NEW EVENTDT,DIRUT,PROMPT

 +2        SET PROMPT="Event Date and Time"

 +3        SET EVENTDT=$$GETDT^PXDATE(-1,-1,-1,DEFAULT,PROMPT,HELP)

 +4        IF $DATA(DIRUT)

               IF (EVENTDT'="@")

                   SET PXCEEND=1

                   QUIT ""

 +5        QUIT EVENTDT

 +6       ;

 +7       ;================================

FUTURE(DATE) ;Return 1 if DATE is in the future.

 +1        IF DATE>$$NOW^XLFDT

               QUIT 1

 +2        QUIT 0

 +3       ;

 +4       ;================================

GETDT(REQTIME,BEFORE,AFTER,DEFAULT,PROMPT,HELP) ;General date/time entry

 +1       ;REQTIME is 1 if time is required,

 +2       ;           0 if time is optional

 +3       ;          -1 if the date can be imprecise

 +4       ;BEFORE  is the maximum number of days before the visit that the date

 +5       ;        can be or -1 for no limit.

 +6       ;AFTER   is the maximum number of days after the visit that the date

 +7       ;        can be or -1 for no limit, except it cannot be in the future.

 +8       ;DEFAULT is the default date/time if there is not one in the file.

 +9       ;        The possible values are NOW or TODAY.

 +10       NEW AFTERDT,BEFOREDT,DIR,VISITDT,X,Y

 +11       SET VISITDT=$PIECE(^TMP("PXK",$JOB,"VST",1,0,"BEFORE"),U,1)

 +12       SET AFTERDT=$SELECT(AFTER=-1:"NOW",1:$$FMADD^XLFDT(VISITDT,-AFTER,0,0,0))

 +13       SET BEFOREDT=$SELECT(BEFORE=-1:"",1:$$FMADD^XLFDT(VISITDT,BEFORE,0,0,0))

 +14      ;Setup the DIR call.

 +15       SET DIR(0)="DO^"_BEFOREDT_":"_AFTERDT_":ESP"

 +16       SET REQTIME=$GET(REQTIME)

 +17       SET DIR(0)=DIR(0)_$SELECT(REQTIME=1:"RX",REQTIME=-1:"T",REQTIME=0:"TX",1:"")

 +18       SET DIR("A")=PROMPT

 +19       SET DIR("B")=$$FMTE^XLFDT(DEFAULT,"5Z")

 +20       IF $GET(HELP)'=""

               SET DIR("??")="^"_HELP

 +21       DO ^DIR

 +22       IF X="@"

               SET Y="@"

 +23       IF X="^"

               SET Y=DEFAULT

 +24       QUIT Y

 +25      ;

 +26      ;================================

ISLEAP(YEAR) ;Given a 3 digit FileMan year return 1 if it is a leap year,

 +1       ;0 otherwise.

 +2        SET YEAR=YEAR+1700

 +3        QUIT (YEAR#4=0)&'(YEAR#100=0)!(YEAR#400=0)

 +4       ;

 +5       ;================================

VFMDATE(X,%DT) ;Is X a valid FileMan date?

 +1        NEW Y

 +2        DO ^%DT

 +3        QUIT Y

 +4       ;