PXCEDATE.m

PXCEDATE ;ISL/dee - Used for things related to Date and Time ;6/20/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**47,161,219**;Aug 12, 1996;Build 5

 ;;Per VA Directive 6402, this routine should not be modified.

 Q

 ;

NEWDATE ;

 D ASKDATE(.PXCEDBEG,.PXCEDEND)

 D DATE9S

 D MAKELIST^PXCENEW

 Q

 ;

ASKDATE(DBEG,DEND) ;

 N NEWDBEG,NEWDEND,PXCEOBEG,PXCEOEND

 S PXCEOBEG=DBEG

 S NEWDBEG=$P($$EDATE("",DBEG),".")

 Q:NEWDBEG<0

 S PXCEOEND=DEND

 S NEWDEND=$P($$LDATE("",DEND),".")

 Q:NEWDEND<0

 S DBEG=$S(NEWDBEG>0:NEWDBEG,1:DBEG)

 S DEND=$S(NEWDEND>0:NEWDEND,1:DEND)

 I DEND<DBEG S DEND=PXCEOEND,DBEG=PXCEOBEG W !,"The Ending Date: "_$$FMTE^XLFDT(NEWDEND)_" cannot be prior to the Start Date: "_$$FMTE^XLFDT(NEWDBEG)_"" D PAUSE^VALM1

 ;I DEND<DBEG S NEWDBEG=DEND,DEND=DBEG,DBEG=NEWDBEG --- removed in 219

 ;D DATE9S  This must be called by the caller if it is wanted.

 Q

 ;

EDATE(PRMPT,DFLT) ; Get early date

 N %DT,X,Y

 S %DT="AEX"

 S %DT("A")=" Start "_$S($L($G(PRMPT)):PRMPT_" ",1:"")_"Date: "

 S %DT("B")=$S($L($G(DFLT)):$$FMTE^XLFDT(DFLT,5),1:"T-30")

 D ^%DT

 Q Y

 ;

LDATE(PRMPT,DFLT) ; Get late date

 N %DT,X,Y

 S %DT="AEX"

 S %DT("A")="Ending "_$S($L($G(PRMPT)):PRMPT_" ",1:"")_"Date: "

 S %DT("B")=$S($L($G(DFLT)):$$FMTE^XLFDT(DFLT,5),1:"TODAY")

 D ^%DT

 Q Y

 ;

DATE9S ;

 S PXCE9END=9999999-PXCEDEND

 S PXCE9BEG=9999999-PXCEDBEG+.999999

 S SDBEG=PXCEDBEG

 S SDEND=PXCEDEND

 Q

 ;

DATE(INDATE) ;Change internal date to an external date.

 N OUTDATE,AT

 Q:INDATE'>0 ""

 S OUTDATE=$$FMTE^XLFDT(INDATE,5)

 S AT=$F(OUTDATE,"@")

 Q $E(OUTDATE,1,(AT-2))_"  "_$P($E(OUTDATE,AT,99),":",1,2)

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXCEDATE   1631     printed  Apr 09, 2024@21:30:12                                                                                                                                                                                                    Page 2

PXCEDATE  ;ISL/dee - Used for things related to Date and Time ;6/20/96

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**47,161,219**;Aug 12, 1996;Build 5

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3        QUIT 

 +4       ;

NEWDATE   ;

 +1        DO ASKDATE(.PXCEDBEG,.PXCEDEND)

 +2        DO DATE9S

 +3        DO MAKELIST^PXCENEW

 +4        QUIT 

 +5       ;

ASKDATE(DBEG,DEND) ;

 +1        NEW NEWDBEG,NEWDEND,PXCEOBEG,PXCEOEND

 +2        SET PXCEOBEG=DBEG

 +3        SET NEWDBEG=$PIECE($$EDATE("",DBEG),".")

 +4        if NEWDBEG<0

               QUIT 

 +5        SET PXCEOEND=DEND

 +6        SET NEWDEND=$PIECE($$LDATE("",DEND),".")

 +7        if NEWDEND<0

               QUIT 

 +8        SET DBEG=$SELECT(NEWDBEG>0:NEWDBEG,1:DBEG)

 +9        SET DEND=$SELECT(NEWDEND>0:NEWDEND,1:DEND)

 +10       IF DEND<DBEG

               SET DEND=PXCEOEND

               SET DBEG=PXCEOBEG

               WRITE !,"The Ending Date: "_$$FMTE^XLFDT(NEWDEND)_" cannot be prior to the Start Date: "_$$FMTE^XLFDT(NEWDBEG)_""

               DO PAUSE^VALM1

 +11      ;I DEND<DBEG S NEWDBEG=DEND,DEND=DBEG,DBEG=NEWDBEG --- removed in 219

 +12      ;D DATE9S  This must be called by the caller if it is wanted.

 +13       QUIT 

 +14      ;

EDATE(PRMPT,DFLT) ; Get early date

 +1        NEW %DT,X,Y

 +2        SET %DT="AEX"

 +3        SET %DT("A")=" Start "_$SELECT($LENGTH($GET(PRMPT)):PRMPT_" ",1:"")_"Date: "

 +4        SET %DT("B")=$SELECT($LENGTH($GET(DFLT)):$$FMTE^XLFDT(DFLT,5),1:"T-30")

 +5        DO ^%DT

 +6        QUIT Y

 +7       ;

LDATE(PRMPT,DFLT) ; Get late date

 +1        NEW %DT,X,Y

 +2        SET %DT="AEX"

 +3        SET %DT("A")="Ending "_$SELECT($LENGTH($GET(PRMPT)):PRMPT_" ",1:"")_"Date: "

 +4        SET %DT("B")=$SELECT($LENGTH($GET(DFLT)):$$FMTE^XLFDT(DFLT,5),1:"TODAY")

 +5        DO ^%DT

 +6        QUIT Y

 +7       ;

DATE9S    ;

 +1        SET PXCE9END=9999999-PXCEDEND

 +2        SET PXCE9BEG=9999999-PXCEDBEG+.999999

 +3        SET SDBEG=PXCEDBEG

 +4        SET SDEND=PXCEDEND

 +5        QUIT 

 +6       ;

DATE(INDATE) ;Change internal date to an external date.

 +1        NEW OUTDATE,AT

 +2        if INDATE'>0

               QUIT ""

 +3        SET OUTDATE=$$FMTE^XLFDT(INDATE,5)

 +4        SET AT=$FIND(OUTDATE,"@")

 +5        QUIT $EXTRACT(OUTDATE,1,(AT-2))_"  "_$PIECE($EXTRACT(OUTDATE,AT,99),":",1,2)

 +6       ;