source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVPST.m@ 623

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1ABSVPST ;VAMC ALTOONA/CTB PRE/POST INIT ;10/22/01 3:41 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**25,28**;JULY 6, 1994
3VHVS 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
8POST ;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
14XFER 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
18XFER1 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
28X 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
40ASKFOR ;;;;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
Note: See TracBrowser for help on using the repository browser.