source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVU.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1ABSVU ;VAMC ALTOONA/CTB - VOLUNTARY UTILITY PROGRAM ;12/5/01 12:18 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**15,23,25,29**;JULY 6, 1994
3 ;ENTRY TO BREAK OUT FULL DESCIPTION FROM SET OF CODES
4 ;VARIABLES: X=INTERNAL VALUE
5 ; DD=DD NUMBER
6 ; F=FIELD NUMBER
7 ;RETURNS DESCRIPTION VALUE IN VARIABLE Y
8 ;RETURNS %=1 WHEN SUCCESSFUL, %=0 WHEN LOOKUP FAILED
9 ;X,DD,F ARE KILLED
10SE I X="" S Y="" Q
11 S I=2 D SET,Y^DIQ,KILL Q
12SET K Y S U="^",%=0,Y="" Q:'$D(X)!('$D(DD))!('$D(F))
13 Q:X=""!(DD="")!(F="")
14 S Y=X,X="S C=$P(^DD("_DD_","_F_",0),U,"_I_")" X X Q
15 Q
16KILL K DD,I,C,X,F Q
17STATUS N X1,X2 S X2=X S X1=$S($D(^ABS(503335,DA,0))#2:$P(^(0),"^",6),1:"")
18 I X1="" D ST S X="Status is set to '"_Y_"'.*" D MSG^ABSVQ S $P(^ABS(503335,DA,0),"^",6)=X2,^ABS(503335,"AF",X2,DA)="" Q
19 I X=X1 D ST S X="Status of '"_Y_"' has not been changed.*" D MSG^ABSVQ Q
20 S X=X1 D ST S $P(X1,"^",2)=Y,X=X2 D ST S $P(X2,"^",2)=Y S X="Status has been changed from '"_$P(X1,"^",2)_"' to '"_$P(X2,"^",2)_"'.*" D MSG^ABSVQ K ^ABS(503335,"AF",+X1,DA) S $P(^ABS(503335,DA,0),"^",6)=+X2,^ABS(503335,"AF",+X2,DA)=""
21 Q
22ST S DD=503335,F=1.9 D V Q
23CLEAR ;CLEAR ALL DATA FROM NATIONAL DIRECTORY
24 N X
25 S X=$G(^ABS(503339.2,0)) Q:X=""
26 K ^ABS(503339.2)
27 S ^ABS(503339.2,0)=$P(X,"^",1,2)
28 QUIT
29LASTNAME ;CLEANS UP ERRONEOUS NODE WHERE APPROPRIATE
30 ;REINDEXES CROSS REFERENCE 3 (TRIGGER OF FIRST CHARACTER OF LAST NAME) ON .01 FIELD OF 503330
31 N N
32 S N=0 F S N=$O(^ABS(503330,N)) Q:'N K ^ABS(503330,N,2,0)
33 S DIK="^ABS(503330,",DIK(1)=".01^3"
34 D ENALL^DIK
35 QUIT
36DRNG ;SELECT RANGE OF DATES
37 K %DT I $D(ABSVDATE) S %DT("B")=$P(ABSVDATE,"^")
38 W ! S %DT="EAT",%DT("A")="Enter Beginning Date: " D ^%DT K %DT("B") I Y<0 K %H,%I,%DT,TO,FR,X,Y S %=0 Q
39 S FR=+Y
40 S %DT("A")=" Enter Ending Date: "
41 I $D(ABSVDATE) S %DT("B")=$S($P(ABSVDATE,"^",2)]"":$P(ABSVDATE,"^",2),1:"TODAY") K ABSVDATE
42 D ^%DT I X["^" K %DT,%H,%I,FR,Y S %=0 Q
43 I Y<0 W "??",!,*7 K %DT,FR,ABS G DRNG
44 S TO=+Y I TO<FR W !,*7,"Illogical range of dates. Try again.",! G DRNG
45 S %=1 K %DT,%H,%I Q
Note: See TracBrowser for help on using the repository browser.