1 | ABSVPST ;VAMC ALTOONA/CTB PRE/POST INIT ;10/22/01 3:41 PM
|
---|
2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**25,28**;JULY 6, 1994
|
---|
3 | VHVS S DIC=503332,DIC(0)="MNZL",DLAYGO=1,X="135V",DIC("DR")="1///VETERANS HISTORY VOLUNTARY SERVICE;2///VHVS" D ^DIC
|
---|
4 | I $P(Y,"^",3) S X="RECORD ADDED!" D MSG^ABSVQ QUIT
|
---|
5 | I +Y S X="RECORD FOR '135V' ALREADY EXISTS, NO ACTION TAKEN!" D MSG^ABSVQ QUIT
|
---|
6 | S X="UNABLE TO ADD RECORD '135V'. PLEASE USE EXISTING TIMEKEEPING OPTION TO ADD RECORD MANUALLY." D MSG^ABSVQ QUIT
|
---|
7 | QUIT
|
---|
8 | POST ;POST INIT TO DELETE 503340 IF IT EXISTS AND TO TRANSFER THE DATA FROM FILE 503461
|
---|
9 | S X="Updating Cross References on File 503334 - VOLUNTEER ORGANIZATION CODES" D MSG^ABSVQ
|
---|
10 | D WAIT^ABSVYN
|
---|
11 | S DIK="^ABS(503334," D IXALL^DIK
|
---|
12 | I $D(^DIZ(503461,0)) D XFER
|
---|
13 | QUIT
|
---|
14 | XFER S ABSVXA="I See that you have data in the Class III NEW DONATIONS file.",ABSVXA(1)="Do you wish to transfer this data NOW",%=2 D ^ABSVYN
|
---|
15 | I %=1 D XFER1 QUIT
|
---|
16 | S X="You may transfer the data at anytime by executing the following:" D MSG^ABSVQ S X=" D XFER^ABSVPST" D MSG^ABSVQ
|
---|
17 | QUIT
|
---|
18 | XFER1 I $P(^ABS(503340,0),"^",3)>0 D I %'=1 S X="No action taken.*" D MSG^ABSVQ QUIT
|
---|
19 | . S ABSVXA="This option will DELETE any existing entries!",ABSVXA(1)="Do you wish to continue",%=2 D ^ABSVYN
|
---|
20 | . Q:%'=1
|
---|
21 | . S ABSVXA="ARE YOU SURE YOU WANT TO CONTINUE",%=2 D ^ABSVYN
|
---|
22 | . QUIT
|
---|
23 | S X="TRANSFER INITIATED." D MSG^ABSVQ
|
---|
24 | K ^ABS(503340)
|
---|
25 | S %X="^DIZ(503461,",%Y="^ABS(503340," D %XY^%RCR
|
---|
26 | S $P(^ABS(503340,0),"^",1,2)="DONATIONS^503340I"
|
---|
27 | S X="TRANSFER COMPLETED." D MSG^ABSVQ
|
---|
28 | X S X="UPDATING TRANSFERRED DATA." D MSG^ABSVQ D WAIT^ABSVYN
|
---|
29 | S DIC=503338,DIC(0)="AEMNZ",DIC("A")="Select VOLUNTARY STATION to be assigned to ALL records: " D ^DIC I Y<0 S X="NO ACTION TAKEN. PLEASE TRANSFER DATA LATER." D MSG^ABSVQ QUIT
|
---|
30 | S ABSV("INST")=+Y,ABSV("SITE")=$P(Y(0),"^",9)
|
---|
31 | S DA=0 F S DA=$O(^ABS(503340,DA)) Q:'DA D
|
---|
32 | .Q:$P(^ABS(503340,DA,0),"^",2)=""
|
---|
33 | .S X=$P(^(0),"^",2),ORG=$P($G(^ABS(503334,X,0)),"^") Q:ORG=""
|
---|
34 | .S Y=$$NEXTORG^ABSVDENT(X)
|
---|
35 | .S Z=$$LZF^ABSVU2(Y,4),Z=ABSV("SITE")_"-"_ORG_"-"_Z
|
---|
36 | .S $P(^ABS(503340,DA,0),"^",1)=Z,$P(^(0),"^",15)=ABSV("INST")
|
---|
37 | .QUIT
|
---|
38 | S DIK="^ABS(503340," D IXALL^DIK
|
---|
39 | QUIT
|
---|
40 | ASKFOR ;;;;RETURNS % WITH EITHER 1 FOR YES OR 0 FOR NO;;;;;
|
---|
41 | S %A="Do you want to continue",%B="Enter Yes or No."
|
---|
42 | W !,%A_"? (Y/N) // " R ANS:$S($D(DTIME):DTIME,1:300)
|
---|
43 | I (ANS["?")!(ANS="") W !,%B G ASKFOR
|
---|
44 | S ANS=$E(ANS,1) S %=$S(ANS="Y":1,ANS="y":1,1:0)
|
---|
45 | K %A,%B,ANS
|
---|
46 | Q
|
---|