| [613] | 1 | ABSVU ;VAMC ALTOONA/CTB - VOLUNTARY UTILITY PROGRAM ;12/5/01 12:18 PM
|
|---|
| 2 | V ;;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
|
|---|
| 10 | SE I X="" S Y="" Q
|
|---|
| 11 | S I=2 D SET,Y^DIQ,KILL Q
|
|---|
| 12 | SET 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
|
|---|
| 16 | KILL K DD,I,C,X,F Q
|
|---|
| 17 | STATUS 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
|
|---|
| 22 | ST S DD=503335,F=1.9 D V Q
|
|---|
| 23 | CLEAR ;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
|
|---|
| 29 | LASTNAME ;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
|
|---|
| 36 | DRNG ;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
|
|---|
