DVBAUDDT1 ;ALB/CP - UTL DVBDATE subroutines & extrinsics #1 ; 10/10/18 2:07pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; ^%DT ; IA #10003
; ^DD("DD" ; IA #10017
; $$FMADD^XLFDT ; IA #10103
; $$FMDIFF^XLFDT ; IA #10103
; $$FMTE^XLFDT ; IA #10103
; $$FMTH^XLFDT ; IA #10103
Q
;
DATE(DVBDATE,DVBTIME,DVBSECS,DVBFORMAT) ; Returns the DVBDATE in external DVBFORMAT.
;
N DVBVAL
;
;
S DVBFORMAT=$G(DVBFORMAT,0) ; DVBDEFAULT DVBDATE DVBFORMAT of MMM DD YYYY HH:MM:SS
S DVBTIME=$G(DVBTIME,0) ; Defaults to returning DVBDATE w/o DVBTIME
S DVBSECS=$G(DVBSECS,0) ; DVBDEFAULT to no seconds returned
;
; Set the appropriate DVBDATE based upon the DVBFORMAT parameter
;
I DVBFORMAT=0 D ; DVBDEFAULT
. S DVBDATE=$$FMTE^XLFDT(DVBDATE) ; yyymmdd.hhmmss to MMM dd, yyyy@hh:mm:ss
I DVBFORMAT=1 D ; Override DVBDEFAULT DVBFORMAT (with MM/DD/YY)
. S DVBDATE=$$FMTE^XLFDT(DVBDATE,"2Z") ;yyymmdd.hhmmss to MM/DD/YY@hh:mm:ss
;
;
S DVBDATE=$TR(DVBDATE,"@"," ") ;........................ See step 1 above
S:DVBFORMAT=0&(DVBDATE[",") DVBDATE=$E(DVBDATE,1,6)_$E(DVBDATE,8,$L(DVBDATE)) ; step 2
I DVBSECS=0 D ; Optionally does not return seconds
. S DVBDATE=$P(DVBDATE,":",1,2) ;............................ step 3 above
;
S DVBVAL=DVBDATE
I DVBTIME=0 D ; Strip off DVBTIME from the DVBDATE based upon DVBFORMAT
. I DVBFORMAT=0 SET DVBVAL=$E(DVBVAL,1,11) ; Strip off DVBTIME: MMM DD YYYY
. I DVBFORMAT=1 SET DVBVAL=$E(DVBVAL,1,8) ;. Strip off DVBTIME: MM/DD/YY
;
QUIT DVBVAL ; DVBDATE
;
DAYSAGO(DVBDATE) ; Returns: DVBDATE (in external mm/dd/yy DVBFORMAT) and the
;
N DVBDAYS,DVBDATEX
; ZEXCEPT: DT
;
S DVBDATE=$P(DVBDATE,".")
S DVBDATEX=$$FMTE^XLFDT(DVBDATE,"2Z") ; External DVBFORMAT mm/dd/yy
;
; Account for a DVBDATE that is yesterday or today
I DVBDATE=DT S DVBDATEX=DVBDATEX_" (today)" QUIT DVBDATEX
I DVBDATE=$$FMADD^XLFDT(DT,-1) D Q DVBDATEX ;
. S DVBDATEX=DVBDATEX_" (yesterday)"
;
; Account for a DVBDATE that is in the future
I DVBDATE=$$FMADD^XLFDT(DT,1) D Q DVBDATEX ;
. S DVBDATEX=DVBDATEX_" (tomorrow)"
I DVBDATE>$$FMADD^XLFDT(DT,1) D Q DVBDATEX ;
. S DVBDAYS=$$FMDIFF^XLFDT(DT,DVBDATE)*-1 ;Change negative to positive
. S DVBDATEX=DVBDATEX_" (in "_DVBDAYS_" DAYS)"
;
; Account for a DVBDATE that is in the past
I DVBDATE D Q DVBDATEX ; Concatenate number of DVBDAYS ago
. S DVBDATEX=DVBDATEX_" ("_$$FMDIFF^XLFDT(DT,DVBDATE)_" DVBDAYS ago)"
;
; Account for a DVBDATE that is the null string
I DVBDATE="" S DVBDATE="<Empty>"
;
Q DVBDATE ; DAYSAGO
;
DTBEG(DVBDTBEG) ; Return: Beginning DVBDATE for DVBDATE range search loop.
;
I DVBDTBEG="" QUIT ""
I $P(DVBDTBEG,".",2) Q $$FMADD^XLFDT(DVBDTBEG,0,0,0,-1) ; 1 sec ago
Q $$FMADD^XLFDT(DVBDTBEG,-1)_.24 ; Day before at midnight ; DVBDTBEG
;
DTEND(DVBDTEND) ; Return: Maximum ending DVBDATE for DVBDATE range search loop.
;
I DVBDTEND="" Q ""
I $P(DVBDTEND,".",2) Q DVBDTEND_"99" ;-> End DVBDATE/DVBTIME = DTMAX
;
QUIT DVBDTEND_.24 ; End DVBDATE at midnight ; DVBDTEND
;
DTSOK(DVBDTBEG,DVBDTEND) ; Extrinsic Return: 1 if end DVBDATE => begin DVBDATE.
;
N DVBVAL
;
S DVBVAL=1
I DVBDTEND<DVBDTBEG D ;
. W $C(7)
. D CENTER^DVBAUDPRT1("Error: From DVBDATE > To DVBDATE",2,80,1)
. S DVBVAL=""
;
Q DVBVAL ; DTSOK
;
GETDT(DVBPROMPT,DVBTYPE,DVBDEFAULT,DVBRESTRICT) ; DVBPROMPT for DVBDATE, & return array
;
N @($$%DT^DVBAUDNEW1())
; ZEXCEPT: %DT,DVB2DTBEG,DVB2DTEND,DVBQUIT,Y
;
S DVBQUIT=0
; Quit, if system DVBDATE for today (DT) is not defined, return DVBQUIT=1
I $L($G(DT))'=7 S DVBQUIT=1 Q
;
; Get the DVBDEFAULT DVBDATE for presentation in the DVBPROMPT
S DVBDEFAULT=$G(DVBDEFAULT)
I DVBDEFAULT="CB" S DVBDEFAULT=$E(DT,1,3)_"0101"
I DVBDEFAULT="CE" S DVBDEFAULT=$E(DT,1,3)_"1231"
I DVBDEFAULT="FB" S DVBDEFAULT=$E(DT,1,3)-$S($E(DT,4,5)<10:1,1:"")_"1001"
I DVBDEFAULT="FE" S DVBDEFAULT=$E(DT,1,3)+$S($E(DT,4,5)>9:1,1:"")_"0930"
I DVBDEFAULT="T" S DVBDEFAULT=DT
;
; Setup call to FM utility ^%DT to DVBPROMPT for DVBDATE
;
S %DT("A")=$G(DVBPROMPT) ; Set DVBDATE prompting text
S %DT="AE" ; (A)sk (E)cho
I $G(DVBRESTRICT)["F" S %DT=%DT_"F" ; (F)uture dates are assumed
I $G(DVBRESTRICT)["P" D ; (P)ast dates are assumed
. S %DT=%DT_"P" ;... (P)ast dates are assumed
. S %DT(0)="-"_DT ;. Up to and including today
I $G(DVBRESTRICT)["R" S %DT=%DT_"R" ; (R)equires DVBTIME
I %DT'["R" S %DT=%DT_"T" ;(T)ime allow but not required
I %DT'["R",%DT'["S",%DT'["T" S %DT=%DT_"T" ;(T)ime allow but not required
I $G(DVBRESTRICT)["S" S %DT=%DT_"S" ; (S)econds should be returned
I DVBDEFAULT S Y=DVBDEFAULT X ^DD("DD") S %DT("B")=Y
;
D ^%DT I Y<1 S DVBQUIT=1 Q
;
; Populate either DVB2DTBEG or DVB2DTEND output array, depends on DVBTYPE
I $G(DVBTYPE)'="E" S DVBTYPE="B" ; Set DVBTYPE DVBDEFAULT
;
I DVBTYPE="B" D ; Begin DVBDATE
. S DVB2DTBEG("I")=Y
. S DVB2DTBEG("$H")=$$FMTH^XLFDT(DVB2DTBEG("I"))
. S DVB2DTBEG("E")=$$DATE(DVB2DTBEG("I"),1,$S(%DT["S":1,1:0))
. W " ",DVB2DTBEG("E") ; Echo DVBDATE in external DVBFORMAT
;
I DVBTYPE="E" D ; End DVBDATE
. S DVB2DTEND("I")=Y
. S DVB2DTEND("$H")=$$FMTH^XLFDT(DVB2DTEND("I"))
. S DVB2DTEND("E")=$$DATE(DVB2DTEND("I"),1)
. W " ",DVB2DTEND("E") ; Echo DVBDATE in external DVBFORMAT
;
Q ; GETDT
;
GETDTS(DVBDATETXT) ; DVBPROMPT user for DVBDATE range
;
GETDTS1 ; Branch to this label upon errors found below
;
; Refresh output
S DVBQUIT=0 ; End DVBDATE might set DVBQUIT=1; then repeat Begin DVBDATE
K DVB2DTBEG,DVB2DTEND
;
W !!,"Enter "_DVBDATETXT_" range"
D GETDT(" Begin date: ","B") Q:DVBQUIT
D GETDT(" End date: ","E") G:DVBQUIT GETDTS1
I '$$DTSOK(DVB2DTBEG("I"),DVB2DTEND("I")) G GETDTS1
;
S DVB2DTBEG=$$DTBEG(DVB2DTBEG("I"))
S DVB2DTEND=$$DTEND(DVB2DTEND("I"))
;
Q ; GETDTS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDDT1 5967 printed Sep 17, 2026@20:27:22 Page 2
DVBAUDDT1 ;ALB/CP - UTL DVBDATE subroutines & extrinsics #1 ; 10/10/18 2:07pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; ^%DT ; IA #10003
+4 ; ^DD("DD" ; IA #10017
+5 ; $$FMADD^XLFDT ; IA #10103
+6 ; $$FMDIFF^XLFDT ; IA #10103
+7 ; $$FMTE^XLFDT ; IA #10103
+8 ; $$FMTH^XLFDT ; IA #10103
+9 QUIT
+10 ;
DATE(DVBDATE,DVBTIME,DVBSECS,DVBFORMAT) ; Returns the DVBDATE in external DVBFORMAT.
+1 ;
+2 NEW DVBVAL
+3 ;
+4 ;
+5 ; DVBDEFAULT DVBDATE DVBFORMAT of MMM DD YYYY HH:MM:SS
SET DVBFORMAT=$GET(DVBFORMAT,0)
+6 ; Defaults to returning DVBDATE w/o DVBTIME
SET DVBTIME=$GET(DVBTIME,0)
+7 ; DVBDEFAULT to no seconds returned
SET DVBSECS=$GET(DVBSECS,0)
+8 ;
+9 ; Set the appropriate DVBDATE based upon the DVBFORMAT parameter
+10 ;
+11 ; DVBDEFAULT
IF DVBFORMAT=0
Begin DoDot:1
+12 ; yyymmdd.hhmmss to MMM dd, yyyy@hh:mm:ss
SET DVBDATE=$$FMTE^XLFDT(DVBDATE)
End DoDot:1
+13 ; Override DVBDEFAULT DVBFORMAT (with MM/DD/YY)
IF DVBFORMAT=1
Begin DoDot:1
+14 ;yyymmdd.hhmmss to MM/DD/YY@hh:mm:ss
SET DVBDATE=$$FMTE^XLFDT(DVBDATE,"2Z")
End DoDot:1
+15 ;
+16 ;
+17 ;........................ See step 1 above
SET DVBDATE=$TRANSLATE(DVBDATE,"@"," ")
+18 ; step 2
if DVBFORMAT=0&(DVBDATE[",")
SET DVBDATE=$EXTRACT(DVBDATE,1,6)_$EXTRACT(DVBDATE,8,$LENGTH(DVBDATE))
+19 ; Optionally does not return seconds
IF DVBSECS=0
Begin DoDot:1
+20 ;............................ step 3 above
SET DVBDATE=$PIECE(DVBDATE,":",1,2)
End DoDot:1
+21 ;
+22 SET DVBVAL=DVBDATE
+23 ; Strip off DVBTIME from the DVBDATE based upon DVBFORMAT
IF DVBTIME=0
Begin DoDot:1
+24 ; Strip off DVBTIME: MMM DD YYYY
IF DVBFORMAT=0
SET DVBVAL=$EXTRACT(DVBVAL,1,11)
+25 ;. Strip off DVBTIME: MM/DD/YY
IF DVBFORMAT=1
SET DVBVAL=$EXTRACT(DVBVAL,1,8)
End DoDot:1
+26 ;
+27 ; DVBDATE
QUIT DVBVAL
+28 ;
DAYSAGO(DVBDATE) ; Returns: DVBDATE (in external mm/dd/yy DVBFORMAT) and the
+1 ;
+2 NEW DVBDAYS,DVBDATEX
+3 ; ZEXCEPT: DT
+4 ;
+5 SET DVBDATE=$PIECE(DVBDATE,".")
+6 ; External DVBFORMAT mm/dd/yy
SET DVBDATEX=$$FMTE^XLFDT(DVBDATE,"2Z")
+7 ;
+8 ; Account for a DVBDATE that is yesterday or today
+9 IF DVBDATE=DT
SET DVBDATEX=DVBDATEX_" (today)"
QUIT DVBDATEX
+10 ;
IF DVBDATE=$$FMADD^XLFDT(DT,-1)
Begin DoDot:1
+11 SET DVBDATEX=DVBDATEX_" (yesterday)"
End DoDot:1
QUIT DVBDATEX
+12 ;
+13 ; Account for a DVBDATE that is in the future
+14 ;
IF DVBDATE=$$FMADD^XLFDT(DT,1)
Begin DoDot:1
+15 SET DVBDATEX=DVBDATEX_" (tomorrow)"
End DoDot:1
QUIT DVBDATEX
+16 ;
IF DVBDATE>$$FMADD^XLFDT(DT,1)
Begin DoDot:1
+17 ;Change negative to positive
SET DVBDAYS=$$FMDIFF^XLFDT(DT,DVBDATE)*-1
+18 SET DVBDATEX=DVBDATEX_" (in "_DVBDAYS_" DAYS)"
End DoDot:1
QUIT DVBDATEX
+19 ;
+20 ; Account for a DVBDATE that is in the past
+21 ; Concatenate number of DVBDAYS ago
IF DVBDATE
Begin DoDot:1
+22 SET DVBDATEX=DVBDATEX_" ("_$$FMDIFF^XLFDT(DT,DVBDATE)_" DVBDAYS ago)"
End DoDot:1
QUIT DVBDATEX
+23 ;
+24 ; Account for a DVBDATE that is the null string
+25 IF DVBDATE=""
SET DVBDATE="<Empty>"
+26 ;
+27 ; DAYSAGO
QUIT DVBDATE
+28 ;
DTBEG(DVBDTBEG) ; Return: Beginning DVBDATE for DVBDATE range search loop.
+1 ;
+2 IF DVBDTBEG=""
QUIT ""
+3 ; 1 sec ago
IF $PIECE(DVBDTBEG,".",2)
QUIT $$FMADD^XLFDT(DVBDTBEG,0,0,0,-1)
+4 ; Day before at midnight ; DVBDTBEG
QUIT $$FMADD^XLFDT(DVBDTBEG,-1)_.24
+5 ;
DTEND(DVBDTEND) ; Return: Maximum ending DVBDATE for DVBDATE range search loop.
+1 ;
+2 IF DVBDTEND=""
QUIT ""
+3 ;-> End DVBDATE/DVBTIME = DTMAX
IF $PIECE(DVBDTEND,".",2)
QUIT DVBDTEND_"99"
+4 ;
+5 ; End DVBDATE at midnight ; DVBDTEND
QUIT DVBDTEND_.24
+6 ;
DTSOK(DVBDTBEG,DVBDTEND) ; Extrinsic Return: 1 if end DVBDATE => begin DVBDATE.
+1 ;
+2 NEW DVBVAL
+3 ;
+4 SET DVBVAL=1
+5 ;
IF DVBDTEND<DVBDTBEG
Begin DoDot:1
+6 WRITE $CHAR(7)
+7 DO CENTER^DVBAUDPRT1("Error: From DVBDATE > To DVBDATE",2,80,1)
+8 SET DVBVAL=""
End DoDot:1
+9 ;
+10 ; DTSOK
QUIT DVBVAL
+11 ;
GETDT(DVBPROMPT,DVBTYPE,DVBDEFAULT,DVBRESTRICT) ; DVBPROMPT for DVBDATE, & return array
+1 ;
+2 NEW @($$%DT^DVBAUDNEW1())
+3 ; ZEXCEPT: %DT,DVB2DTBEG,DVB2DTEND,DVBQUIT,Y
+4 ;
+5 SET DVBQUIT=0
+6 ; Quit, if system DVBDATE for today (DT) is not defined, return DVBQUIT=1
+7 IF $LENGTH($GET(DT))'=7
SET DVBQUIT=1
QUIT
+8 ;
+9 ; Get the DVBDEFAULT DVBDATE for presentation in the DVBPROMPT
+10 SET DVBDEFAULT=$GET(DVBDEFAULT)
+11 IF DVBDEFAULT="CB"
SET DVBDEFAULT=$EXTRACT(DT,1,3)_"0101"
+12 IF DVBDEFAULT="CE"
SET DVBDEFAULT=$EXTRACT(DT,1,3)_"1231"
+13 IF DVBDEFAULT="FB"
SET DVBDEFAULT=$EXTRACT(DT,1,3)-$SELECT($EXTRACT(DT,4,5)<10:1,1:"")_"1001"
+14 IF DVBDEFAULT="FE"
SET DVBDEFAULT=$EXTRACT(DT,1,3)+$SELECT($EXTRACT(DT,4,5)>9:1,1:"")_"0930"
+15 IF DVBDEFAULT="T"
SET DVBDEFAULT=DT
+16 ;
+17 ; Setup call to FM utility ^%DT to DVBPROMPT for DVBDATE
+18 ;
+19 ; Set DVBDATE prompting text
SET %DT("A")=$GET(DVBPROMPT)
+20 ; (A)sk (E)cho
SET %DT="AE"
+21 ; (F)uture dates are assumed
IF $GET(DVBRESTRICT)["F"
SET %DT=%DT_"F"
+22 ; (P)ast dates are assumed
IF $GET(DVBRESTRICT)["P"
Begin DoDot:1
+23 ;... (P)ast dates are assumed
SET %DT=%DT_"P"
+24 ;. Up to and including today
SET %DT(0)="-"_DT
End DoDot:1
+25 ; (R)equires DVBTIME
IF $GET(DVBRESTRICT)["R"
SET %DT=%DT_"R"
+26 ;(T)ime allow but not required
IF %DT'["R"
SET %DT=%DT_"T"
+27 ;(T)ime allow but not required
IF %DT'["R"
IF %DT'["S"
IF %DT'["T"
SET %DT=%DT_"T"
+28 ; (S)econds should be returned
IF $GET(DVBRESTRICT)["S"
SET %DT=%DT_"S"
+29 IF DVBDEFAULT
SET Y=DVBDEFAULT
XECUTE ^DD("DD")
SET %DT("B")=Y
+30 ;
+31 DO ^%DT
IF Y<1
SET DVBQUIT=1
QUIT
+32 ;
+33 ; Populate either DVB2DTBEG or DVB2DTEND output array, depends on DVBTYPE
+34 ; Set DVBTYPE DVBDEFAULT
IF $GET(DVBTYPE)'="E"
SET DVBTYPE="B"
+35 ;
+36 ; Begin DVBDATE
IF DVBTYPE="B"
Begin DoDot:1
+37 SET DVB2DTBEG("I")=Y
+38 SET DVB2DTBEG("$H")=$$FMTH^XLFDT(DVB2DTBEG("I"))
+39 SET DVB2DTBEG("E")=$$DATE(DVB2DTBEG("I"),1,$SELECT(%DT["S":1,1:0))
+40 ; Echo DVBDATE in external DVBFORMAT
WRITE " ",DVB2DTBEG("E")
End DoDot:1
+41 ;
+42 ; End DVBDATE
IF DVBTYPE="E"
Begin DoDot:1
+43 SET DVB2DTEND("I")=Y
+44 SET DVB2DTEND("$H")=$$FMTH^XLFDT(DVB2DTEND("I"))
+45 SET DVB2DTEND("E")=$$DATE(DVB2DTEND("I"),1)
+46 ; Echo DVBDATE in external DVBFORMAT
WRITE " ",DVB2DTEND("E")
End DoDot:1
+47 ;
+48 ; GETDT
QUIT
+49 ;
GETDTS(DVBDATETXT) ; DVBPROMPT user for DVBDATE range
+1 ;
GETDTS1 ; Branch to this label upon errors found below
+1 ;
+2 ; Refresh output
+3 ; End DVBDATE might set DVBQUIT=1; then repeat Begin DVBDATE
SET DVBQUIT=0
+4 KILL DVB2DTBEG,DVB2DTEND
+5 ;
+6 WRITE !!,"Enter "_DVBDATETXT_" range"
+7 DO GETDT(" Begin date: ","B")
if DVBQUIT
QUIT
+8 DO GETDT(" End date: ","E")
if DVBQUIT
GOTO GETDTS1
+9 IF '$$DTSOK(DVB2DTBEG("I"),DVB2DTEND("I"))
GOTO GETDTS1
+10 ;
+11 SET DVB2DTBEG=$$DTBEG(DVB2DTBEG("I"))
+12 SET DVB2DTEND=$$DTEND(DVB2DTEND("I"))
+13 ;
+14 ; GETDTS
QUIT
