DICATTD1 ;SFISC/GFT- DATE,TIME ;2 FEB 2009
;;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.
;
EARLY ;
S Y=">X" G Y
;
LATEST ;
S Y="<X"
Y S Y=$F(DICATT5,Y) I Y S Y=$E(DICATT5,Y-9,Y-3) S:Y?.E1"DT" Y="DT" D:Y DD^%DT Q
K Y Q
;
POST1 ;check DATE
N Z,Y,%DT,I K DDSERROR
S %DT="T"
D I $D(DDSERROR) D HLP^DDSUTL("'EARLIEST DATE' & 'LATEST DATE' ARE IN WRONG ORDER") S DDSBR="21^DICATT1^2.1" Q
.S Y=$$G(21) I Y="DT" S X=$$G(22) D:X]"" Q
..I X'="DT" D ^%DT I Y<DT S DDSERROR=1 Q
.Q:Y="" S X=Y D ^%DT S X=$$G(22) Q:X="" I X="DT" S:Y>DT DDSERROR=1 Q
.S Z=Y D ^%DT I Y<Z S DDSERROR=1
S DICATT5N="S %DT=""E"_$E("S",$$G(25)=1)_$E("T",$$G(24)=1)_$E("X",$$G(23)=0)_$E("R",$$G(26)=1)_""" D ^%DT S X=Y K:"
FROMTO K DICATTMN F I=21,22 S Z=$$G(I) Q:Z="" D
.I Z="DT" S Y=Z,Z="CURRENT DATE"
.E S X=Z D ^%DT S X=Y D DD^%DT S Z=Y,Y=X
.S DICATTMN(I)=Z,DICATT5N(I)=Y ;Z is readable, Y internal
I $D(DICATTMN(22)) S DICATTMN="Type a date between "_DICATTMN(21)_" and "_DICATTMN(22)_".",DICATT5N=DICATT5N_DICATT5N(22)_"<X!("_DICATT5N(21)_">X) X"
E I $D(DICATTMN(21)) S DICATTMN="Type a date not earlier than "_DICATTMN(21)_".",DICATT5N=DICATT5N_DICATT5N(21)_">X X"
E S DICATT5N=DICATT5N_"X<1 X",DICATTMN="(No range limit on date)"
S DICATTLN=$$G(24)=1*5+7
S DICATT2N="D",DICATT3N=""
S X=DICATT5N K DICATT5N S DICATT5N=X ;get rid of those damn subscripts
CHNG I DICATT5N=DICATT5 K DICATTMN ;No DICATTMN means no change
D:$D(DICATTMN) PUT^DDSVALF(98,"DICATT",1,DICATTMN)
Q
;
G(I) N X Q $$GET^DDSVALF(I,"DICATT1",2.1,"I","")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICATTD1 1818 printed Oct 16, 2024@18:46:12 Page 2
DICATTD1 ;SFISC/GFT- DATE,TIME ;2 FEB 2009
+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 ;
EARLY ;
+1 SET Y=">X"
GOTO Y
+2 ;
LATEST ;
+1 SET Y="<X"
Y SET Y=$FIND(DICATT5,Y)
IF Y
SET Y=$EXTRACT(DICATT5,Y-9,Y-3)
if Y?.E1"DT"
SET Y="DT"
if Y
DO DD^%DT
QUIT
+1 KILL Y
QUIT
+2 ;
POST1 ;check DATE
+1 NEW Z,Y,%DT,I
KILL DDSERROR
+2 SET %DT="T"
+3 Begin DoDot:1
+4 SET Y=$$G(21)
IF Y="DT"
SET X=$$G(22)
if X]""
Begin DoDot:2
+5 IF X'="DT"
DO ^%DT
IF Y<DT
SET DDSERROR=1
QUIT
End DoDot:2
QUIT
+6 if Y=""
QUIT
SET X=Y
DO ^%DT
SET X=$$G(22)
if X=""
QUIT
IF X="DT"
if Y>DT
SET DDSERROR=1
QUIT
+7 SET Z=Y
DO ^%DT
IF Y<Z
SET DDSERROR=1
End DoDot:1
IF $DATA(DDSERROR)
DO HLP^DDSUTL("'EARLIEST DATE' & 'LATEST DATE' ARE IN WRONG ORDER")
SET DDSBR="21^DICATT1^2.1"
QUIT
+8 SET DICATT5N="S %DT=""E"_$EXTRACT("S",$$G(25)=1)_$EXTRACT("T",$$G(24)=1)_$EXTRACT("X",$$G(23)=0)_$EXTRACT("R",$$G(26)=1)_""" D ^%DT S X=Y K:"
FROMTO KILL DICATTMN
FOR I=21,22
SET Z=$$G(I)
if Z=""
QUIT
Begin DoDot:1
+1 IF Z="DT"
SET Y=Z
SET Z="CURRENT DATE"
+2 IF '$TEST
SET X=Z
DO ^%DT
SET X=Y
DO DD^%DT
SET Z=Y
SET Y=X
+3 ;Z is readable, Y internal
SET DICATTMN(I)=Z
SET DICATT5N(I)=Y
End DoDot:1
+4 IF $DATA(DICATTMN(22))
SET DICATTMN="Type a date between "_DICATTMN(21)_" and "_DICATTMN(22)_"."
SET DICATT5N=DICATT5N_DICATT5N(22)_"<X!("_DICATT5N(21)_">X) X"
+5 IF '$TEST
IF $DATA(DICATTMN(21))
SET DICATTMN="Type a date not earlier than "_DICATTMN(21)_"."
SET DICATT5N=DICATT5N_DICATT5N(21)_">X X"
+6 IF '$TEST
SET DICATT5N=DICATT5N_"X<1 X"
SET DICATTMN="(No range limit on date)"
+7 SET DICATTLN=$$G(24)=1*5+7
+8 SET DICATT2N="D"
SET DICATT3N=""
+9 ;get rid of those damn subscripts
SET X=DICATT5N
KILL DICATT5N
SET DICATT5N=X
CHNG ;No DICATTMN means no change
IF DICATT5N=DICATT5
KILL DICATTMN
+1 if $DATA(DICATTMN)
DO PUT^DDSVALF(98,"DICATT",1,DICATTMN)
+2 QUIT
+3 ;
G(I) NEW X
QUIT $$GET^DDSVALF(I,"DICATT1",2.1,"I","")
