source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVE1.m@ 846

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1ABSVE1 ;VAMC ALTOONA/CTB/CLH - VOL. FILE EDIT ;8/23/01 4:10 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**10,25**;JULY 6, 1994
3OUT K %,%Y,C,D0,DDH,DG,DI,DQ,DIC,DLAYGO,DR,DA,X,Y Q
4SAC ;Edit File 503332 - Voluntary Service Assignment Codes
5 S (DIC,DLAYGO)=503332,DIC(0)="AEMQL",DIC("A")="Select SERVICE ASSIGNMENT CODE: " D ^DIC K DIC G:+Y<0 OUT S DA=+Y
6 S DIE=503332,DR="1;2" D ^DIE K DIE W !! G SAC
7SWD ;Edit File 503333 - Volunteer's Scheduled Workdays
8 S (DIC,DLAYGO)=503333,DIC(0)="AELMQ",DIC("A")="Select WORK DAY SCHEDULE: " D ^DIC K DIC G:+Y<0 OUT S DA=+Y
9 S DIE=503333,DR="1;2" D ^DIE K DIE W !! G SWD
10OC ;Edit File 503334 - Volunteer Organization Codes
11 S (DIC,DLAYGO)=503334,DIC(0)="AELMQ",DIC("A")="Select ORGANIZATION CODE: " D ^DIC K DIC G:+Y<0 OUT S DA=+Y
12 S DIE=503334,DR="1;1.5;3;4" D ^DIE K DIE W !! G OC
13AC ;Edit File 503337 - Voluntary Award Codes
14 S (DIC,DLAYGO)=503337,DIC(0)="AELMQ",DIC("A")="Select AWARD NAME or CODE: " D ^DIC K DIC G:+Y<0 OUT S DA=+Y
15 S DIE=503337,DR=".01;1;2" D ^DIE K DIE W !! G AC
16SE ;Edit File 503338 - Voluntary Service Site Parameter
17 S (DIC,DLAYGO)=503338,DIC(0)="AEMQL",DIC("A")="Select Voluntary Service Site Name: " D ^DIC K DIC G:+Y<0 OUT S DA=+Y
18 S DIE=503338,DR="[ABSV SITE EDIT]" D ^DIE K DIE W !! G SE
19SITE D ^ABSVSITE G:'% OUT
20 Q
21DELCOMB ;DELETE COMBINATIONS
22 N %,C,D,D0,D1,DA,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,FPASS,I,N,X,Y
23 D ^ABSVSITE G OUT1:'%
24 S X=$E(DT,4,7) I +X<1010!(+X>1106) S X="I'm sorry, but combinations may only be deleted from October 10th through November 6th of each year to prevent loss of hours in Austin.*" D MSG^ABSVQ QUIT
25 S DIC("A")="Select VOLUNTEER: "
26C2 S FPASS=1,DIC=503330,DIC(0)="AEMQ"
27 F D MDIV^ABSVSITE,^DIC G OUT1:Y<0 Q:$$ACTIVE^ABSVU2(+Y,ABSV("INST"))
28 K DIC S DA=+Y,ABSVX("NAME")=$P(Y,"^",2),ABSVX("VOLDA")=DA
29C1 D PCOMB^ABSVE2 G OUT1:'$D(ABSVX("LIST"))
30 S DIR(0)="NOA^1:6:0",DIR("A")="Select Combination Number: "
31 S DIR("?")="Enter the number assigned to the Combination you wish to delete,",DIR("?",1)="Enter a combination number, or an '^' to Quit." D ^DIR K DIR
32 I $$DIR^ABSVU2 S X=$S($D(FPASS):" <No Selection Made.>*",1:" <Updating Completed>*") D MSG^ABSVQ,OUT1 S DIC("A")="Select Next VOLUNTEER: " G C2
33 I '$D(ABSVX("LIST",+Y)) S DA(1)=ABSVX("VOLDA"),X=ABSV("SITE")_"-"_X,DIC="^ABS(503330,"_DA(1)_",1,",DIC(0)="EMQL",DLAYGO=503330 D ^DIC K DIC S DA=ABSVX("VOLDA") K DA(1) G:Y<0 C1 S Y=+$P(Y,"-",2)
34 S $P(Y,"^",2)=$O(^ABS(503330,DA,1,"AD",ABSV("SITE"),Y,0))
35 S DA(1)=ABSVX("VOLDA"),DA=$P(Y,"^",2)
36 I DA="" S X="I'm sorry but I'm a little confused, let's try that again." D MSG^ABSVQ S DA=DA(1) G C1
37 S ABSVXA="ARE YOU SURE",ABSVXB="",%=2
38 D ^ABSVYN I %=1 S DIK="^ABS(503330,"_DA(1)_",1," D WAIT^ABSVYN D ^DIK S X=" <Combination Deleted>*" D MSG^ABSVQ R X:1 S EDIT=""
39 S DA=ABSVX("VOLDA") K DA(1),FPASS G C1
40OUT1 I $D(ABSVX("EDIT")) K ABSVX("EDIT"),COMB,DAY,DIC,DI,D0,DQ,DR,DUOUT,DIE,DATE,ORG,SER,VOL,I,N,X,Y
41 I $D(EDIT) D TT88^ABSVE3
42 K ABSVX("NAME"),ABSVX("VOLDA"),ABSVX("LIST")
43 QUIT
Note: See TracBrowser for help on using the repository browser.