1 | DICATTD1 ;SFISC/GFT ;10:08 AM 26 Jan 2001;DATE-TIME
|
---|
2 | ;;22.0;VA FileMan;**42**;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | EARLY ;
|
---|
6 | S Y=">X" G Y
|
---|
7 | ;
|
---|
8 | LATEST ;
|
---|
9 | S Y="<X"
|
---|
10 | 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
|
---|
11 | K Y Q
|
---|
12 | ;
|
---|
13 | POST1 ;check DATE
|
---|
14 | N Z,Y,%DT,I K DDSERROR
|
---|
15 | S %DT="T"
|
---|
16 | D I $D(DDSERROR) D HLP^DDSUTL("'EARLIEST DATE' & 'LATEST DATE' ARE IN WRONG ORDER") S DDSBR="21^DICATT1^2.1" Q
|
---|
17 | .S Y=$$G(21) I Y="DT" S X=$$G(22) D:X]"" Q
|
---|
18 | ..I X'="DT" D ^%DT I Y<DT S DDSERROR=1 Q
|
---|
19 | .Q:Y="" S X=Y D ^%DT S X=$$G(22) Q:X="" I X="DT" S:Y>DT DDSERROR=1 Q
|
---|
20 | .S Z=Y D ^%DT I Y<Z S DDSERROR=1
|
---|
21 | 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:"
|
---|
22 | FROMTO K DICATTMN F I=21,22 S Z=$$G(I) Q:Z="" D
|
---|
23 | .I Z="DT" S Y=Z,Z="CURRENT DATE"
|
---|
24 | .E S X=Z D ^%DT S X=Y D DD^%DT S Z=Y,Y=X
|
---|
25 | .S DICATTMN(I)=Z,DICATT5N(I)=Y ;Z is readable, Y internal
|
---|
26 | I $D(DICATTMN(22)) S DICATTMN="TYPE A DATE BETWEEN "_DICATTMN(21)_" AND "_DICATTMN(22),DICATT5N=DICATT5N_DICATT5N(22)_"<X!("_DICATT5N(21)_">X) X"
|
---|
27 | E I $D(DICATTMN(21)) S DICATTMN="TYPE A DATE NOT EARLIER THAN "_DICATTMN(21),DICATT5N=DICATT5N_DICATT5N(21)_">X X"
|
---|
28 | E S DICATT5N=DICATT5N_"X<1 X",DICATTMN="(No range limit on date)"
|
---|
29 | S DICATTLN=$$G(24)=1*5+7
|
---|
30 | S DICATT2N="D",DICATT3N=""
|
---|
31 | S X=DICATT5N K DICATT5N S DICATT5N=X ;get rid of those damn subscripts
|
---|
32 | CHNG I DICATT5N=DICATT5 K DICATTMN ;No DICATTMN means no change
|
---|
33 | D:$D(DICATTMN) PUT^DDSVALF(98,"DICATT",1,DICATTMN)
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | G(I) N X Q $$GET^DDSVALF(I,"DICATT1",2.1,"I","")
|
---|