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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HABSVU 2072 printed Jan 14, 2021@17:31:42 Page 2
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
+1 ;ENTRY TO BREAK OUT FULL DESCIPTION FROM SET OF CODES
+2 ;VARIABLES: X=INTERNAL VALUE
+3 ; DD=DD NUMBER
+4 ; F=FIELD NUMBER
+5 ;RETURNS DESCRIPTION VALUE IN VARIABLE Y
+6 ;RETURNS %=1 WHEN SUCCESSFUL, %=0 WHEN LOOKUP FAILED
+7 ;X,DD,F ARE KILLED
SE IF X=""
SET Y=""
QUIT
+1 SET I=2
DO SET
DO Y^DIQ
DO KILL
QUIT
SET KILL Y
SET U="^"
SET %=0
SET Y=""
if '$DATA(X)!('$DATA(DD))!('$DATA(F))
QUIT
+1 if X=""!(DD="")!(F="")
QUIT
+2 SET Y=X
SET X="S C=$P(^DD("_DD_","_F_",0),U,"_I_")"
XECUTE X
QUIT
+3 QUIT
KILL KILL DD,I,C,X,F
QUIT
STATUS NEW X1,X2
SET X2=X
SET X1=$SELECT($DATA(^ABS(503335,DA,0))#2:$PIECE(^(0),"^",6),1:"")
+1 IF X1=""
DO ST
SET X="Status is set to '"_Y_"'.*"
DO MSG^ABSVQ
SET $PIECE(^ABS(503335,DA,0),"^",6)=X2
SET ^ABS(503335,"AF",X2,DA)=""
QUIT
+2 IF X=X1
DO ST
SET X="Status of '"_Y_"' has not been changed.*"
DO MSG^ABSVQ
QUIT
+3 SET X=X1
DO ST
SET $PIECE(X1,"^",2)=Y
SET X=X2
DO ST
SET $PIECE(X2,"^",2)=Y
SET X="Status has been changed from '"_$PIECE(X1,"^",2)_"' to '"_$PIECE(X2,"^",2)_"'.*"
DO MSG^ABSVQ
KILL ^ABS(503335,"AF",+X1,DA)
SET $PIECE(^ABS(503335,DA,0),"^",6)=+X2
SET ^ABS(503335,"AF",+X2,DA)=""
+4 QUIT
ST SET DD=503335
SET F=1.9
DO V
QUIT
CLEAR ;CLEAR ALL DATA FROM NATIONAL DIRECTORY
+1 NEW X
+2 SET X=$GET(^ABS(503339.2,0))
if X=""
QUIT
+3 KILL ^ABS(503339.2)
+4 SET ^ABS(503339.2,0)=$PIECE(X,"^",1,2)
+5 QUIT
LASTNAME ;CLEANS UP ERRONEOUS NODE WHERE APPROPRIATE
+1 ;REINDEXES CROSS REFERENCE 3 (TRIGGER OF FIRST CHARACTER OF LAST NAME) ON .01 FIELD OF 503330
+2 NEW N
+3 SET N=0
FOR
SET N=$ORDER(^ABS(503330,N))
if 'N
QUIT
KILL ^ABS(503330,N,2,0)
+4 SET DIK="^ABS(503330,"
SET DIK(1)=".01^3"
+5 DO ENALL^DIK
+6 QUIT
DRNG ;SELECT RANGE OF DATES
+1 KILL %DT
IF $DATA(ABSVDATE)
SET %DT("B")=$PIECE(ABSVDATE,"^")
+2 WRITE !
SET %DT="EAT"
SET %DT("A")="Enter Beginning Date: "
DO ^%DT
KILL %DT("B")
IF Y<0
KILL %H,%I,%DT,TO,FR,X,Y
SET %=0
QUIT
+3 SET FR=+Y
+4 SET %DT("A")=" Enter Ending Date: "
+5 IF $DATA(ABSVDATE)
SET %DT("B")=$SELECT($PIECE(ABSVDATE,"^",2)]"":$PIECE(ABSVDATE,"^",2),1:"TODAY")
KILL ABSVDATE
+6 DO ^%DT
IF X["^"
KILL %DT,%H,%I,FR,Y
SET %=0
QUIT
+7 IF Y<0
WRITE "??",!,*7
KILL %DT,FR,ABS
GOTO DRNG
+8 SET TO=+Y
IF TO<FR
WRITE !,*7,"Illogical range of dates. Try again.",!
GOTO DRNG
+9 SET %=1
KILL %DT,%H,%I
QUIT
