DIEH1 ;SFISC/DPC-DBS HELP CON'T ;05:41 PM 8 Aug 2002
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;;
DT(DIEHDT,DIWRITE) ; **CCO/NI OPTIONAL 'DIWRITE' PARAMETER ADDED SO WE CAN CALL THIS FROM DIEQ AS WELL AS DIEFU AND DIEH FOR FOREIGN-LANGUAGE DATE-HELP
N P,Q
I DIEHDT'["N" S P(1)=$$EZBLD^DIALOG($S(DIEHDT["M":9110.8,1:9110.1)) ;22*85 **CCO/NI 'OR 0157' 'OR 120157'
D
. I DIEHDT["P" S P(2)=$$EZBLD^DIALOG(9110.2) Q ;**CCO/NI 'PAST'
. I DIEHDT["F" S P(2)=$$EZBLD^DIALOG(9110.3) Q ;**CCO/NI 'FUTURE'
. S P(2)=$$EZBLD^DIALOG(9110.4) ;**CCO/NI 'ASSUMES CURRENT YEAR'
. S P(3)=$$EZBLD^DIALOG(9110.5) ;**CCO/NI '20 YEARS future, 80 past'
. Q
M I DIEHDT["M" D BLD^DIALOG(9110.7,.P,.P) G W ;22*85
I DIEHDT'["X" D
. N X S X=$$EZBLD^DIALOG(9110.6) ;**CCO/NI 'MAY OMIT PRECISE DATE'
. I $G(P(3))]"" S P(4)=X Q
. S P(3)=X Q
D BLD^DIALOG(9110,.P,.P)
I DIEHDT["T"!(DIEHDT["R") D
. I DIEHDT["S" S Q(1)=$$EZBLD^DIALOG(9112) ;**CCO/NI 'SECONDS ALLOWED'
. I DIEHDT["R" S Q(2)=$$EZBLD^DIALOG(9113) ;**CCO/NI 'TIME REQUIRED'
. D BLD^DIALOG(9111,.Q,.Q)
. Q
W I $G(DIWRITE) D MSG^DIALOG("WH") ;**CCO/NI NEW DIWRITE PARAMETER WRITES IT OUT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIEH1 1436 printed Oct 16, 2024@18:47:44 Page 2
DIEH1 ;SFISC/DPC-DBS HELP CON'T ;05:41 PM 8 Aug 2002
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;;
DT(DIEHDT,DIWRITE) ; **CCO/NI OPTIONAL 'DIWRITE' PARAMETER ADDED SO WE CAN CALL THIS FROM DIEQ AS WELL AS DIEFU AND DIEH FOR FOREIGN-LANGUAGE DATE-HELP
+1 NEW P,Q
+2 ;22*85 **CCO/NI 'OR 0157' 'OR 120157'
IF DIEHDT'["N"
SET P(1)=$$EZBLD^DIALOG($SELECT(DIEHDT["M":9110.8,1:9110.1))
+3 Begin DoDot:1
+4 ;**CCO/NI 'PAST'
IF DIEHDT["P"
SET P(2)=$$EZBLD^DIALOG(9110.2)
QUIT
+5 ;**CCO/NI 'FUTURE'
IF DIEHDT["F"
SET P(2)=$$EZBLD^DIALOG(9110.3)
QUIT
+6 ;**CCO/NI 'ASSUMES CURRENT YEAR'
SET P(2)=$$EZBLD^DIALOG(9110.4)
+7 ;**CCO/NI '20 YEARS future, 80 past'
SET P(3)=$$EZBLD^DIALOG(9110.5)
+8 QUIT
End DoDot:1
M ;22*85
IF DIEHDT["M"
DO BLD^DIALOG(9110.7,.P,.P)
GOTO W
+1 IF DIEHDT'["X"
Begin DoDot:1
+2 ;**CCO/NI 'MAY OMIT PRECISE DATE'
NEW X
SET X=$$EZBLD^DIALOG(9110.6)
+3 IF $GET(P(3))]""
SET P(4)=X
QUIT
+4 SET P(3)=X
QUIT
End DoDot:1
+5 DO BLD^DIALOG(9110,.P,.P)
+6 IF DIEHDT["T"!(DIEHDT["R")
Begin DoDot:1
+7 ;**CCO/NI 'SECONDS ALLOWED'
IF DIEHDT["S"
SET Q(1)=$$EZBLD^DIALOG(9112)
+8 ;**CCO/NI 'TIME REQUIRED'
IF DIEHDT["R"
SET Q(2)=$$EZBLD^DIALOG(9113)
+9 DO BLD^DIALOG(9111,.Q,.Q)
+10 QUIT
End DoDot:1
W ;**CCO/NI NEW DIWRITE PARAMETER WRITES IT OUT
IF $GET(DIWRITE)
DO MSG^DIALOG("WH")
+1 QUIT
+2 ;
