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 ---[H[J[2J[HPXCEDATE 1631 printed Dec 13, 2024@02:27:59 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 ;
