- 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 Feb 18, 2025@23:54:16 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 ;