46 lines
2.0 KiB
Mathematica
46 lines
2.0 KiB
Mathematica
ABSVU ;VAMC ALTOONA/CTB - VOLUNTARY UTILITY PROGRAM ;12/5/01 12:18 PM
|
|
V ;;4.0;VOLUNTARY TIMEKEEPING;**15,23,25,29**;JULY 6, 1994
|
|
;ENTRY TO BREAK OUT FULL DESCIPTION FROM SET OF CODES
|
|
;VARIABLES: X=INTERNAL VALUE
|
|
; DD=DD NUMBER
|
|
; F=FIELD NUMBER
|
|
;RETURNS DESCRIPTION VALUE IN VARIABLE Y
|
|
;RETURNS %=1 WHEN SUCCESSFUL, %=0 WHEN LOOKUP FAILED
|
|
;X,DD,F ARE KILLED
|
|
SE I X="" S Y="" Q
|
|
S I=2 D SET,Y^DIQ,KILL Q
|
|
SET K Y S U="^",%=0,Y="" Q:'$D(X)!('$D(DD))!('$D(F))
|
|
Q:X=""!(DD="")!(F="")
|
|
S Y=X,X="S C=$P(^DD("_DD_","_F_",0),U,"_I_")" X X Q
|
|
Q
|
|
KILL K DD,I,C,X,F Q
|
|
STATUS N X1,X2 S X2=X S X1=$S($D(^ABS(503335,DA,0))#2:$P(^(0),"^",6),1:"")
|
|
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
|
|
I X=X1 D ST S X="Status of '"_Y_"' has not been changed.*" D MSG^ABSVQ Q
|
|
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)=""
|
|
Q
|
|
ST S DD=503335,F=1.9 D V Q
|
|
CLEAR ;CLEAR ALL DATA FROM NATIONAL DIRECTORY
|
|
N X
|
|
S X=$G(^ABS(503339.2,0)) Q:X=""
|
|
K ^ABS(503339.2)
|
|
S ^ABS(503339.2,0)=$P(X,"^",1,2)
|
|
QUIT
|
|
LASTNAME ;CLEANS UP ERRONEOUS NODE WHERE APPROPRIATE
|
|
;REINDEXES CROSS REFERENCE 3 (TRIGGER OF FIRST CHARACTER OF LAST NAME) ON .01 FIELD OF 503330
|
|
N N
|
|
S N=0 F S N=$O(^ABS(503330,N)) Q:'N K ^ABS(503330,N,2,0)
|
|
S DIK="^ABS(503330,",DIK(1)=".01^3"
|
|
D ENALL^DIK
|
|
QUIT
|
|
DRNG ;SELECT RANGE OF DATES
|
|
K %DT I $D(ABSVDATE) S %DT("B")=$P(ABSVDATE,"^")
|
|
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
|
|
S FR=+Y
|
|
S %DT("A")=" Enter Ending Date: "
|
|
I $D(ABSVDATE) S %DT("B")=$S($P(ABSVDATE,"^",2)]"":$P(ABSVDATE,"^",2),1:"TODAY") K ABSVDATE
|
|
D ^%DT I X["^" K %DT,%H,%I,FR,Y S %=0 Q
|
|
I Y<0 W "??",!,*7 K %DT,FR,ABS G DRNG
|
|
S TO=+Y I TO<FR W !,*7,"Illogical range of dates. Try again.",! G DRNG
|
|
S %=1 K %DT,%H,%I Q
|