PXCEDATE.m

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

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**47**;Aug 12, 1996

 ;; ;

 Q

 ;

NEWDATE ;

 D ASKDATE(.PXCEDBEG,.PXCEDEND)

 D DATE9S

 D MAKELIST^PXCENEW

 Q

 ;

ASKDATE(DBEG,DEND) ;

 N NEWDBEG,NEWDEND

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

 Q:NEWDBEG<0

 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 NEWDBEG=DEND,DEND=DBEG,DBEG=NEWDBEG

 ;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="AEPX"

 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)

 ;

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

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**47**;Aug 12, 1996

 +2       ;; ;

 +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

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

 +3        IF NEWDBEG<0

               QUIT 

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

 +5        IF NEWDEND<0

               QUIT 

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

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

 +8        IF DEND<DBEG

               SET NEWDBEG=DEND

               SET DEND=DBEG

               SET DBEG=NEWDBEG

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

 +10       QUIT 

 +11      ;

EDATE(PRMPT,DFLT) ; Get early date

 +1        NEW %DT,X,Y

 +2        SET %DT="AEPX"

 +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       ;