source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVNIT2.m@ 738

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1ABSVNIT2 ;VAMC ALTOONA/CTB_CLH - TRANSFER TEMP LOG CON'T ;2/11/98 11:29 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**3,6,7**;JULY 6, 1994
3 ;
4LUN(LUN) ;SETS TO MEAL TICKET FILE.
5 N X,Y,DA,DIC,DA,DIK,NOW
6 S X=$P($G(^ABS(503330,ABSVX("VOLDA"),0)),"^",2)
7 I '$D(ABSVX("NAME")) S ABSVX("NAME")=$P($G(^ABS(503330,ABSVX("VOLDA"),0)),"^",1)
8 S:X="" X=ABSVX("VOLDA")
9 S DIC="^ABS(503330.2,",DIC(0)="MN",DIC("S")="I $P(^(0),U,4)=+DT,$P(^(0),U,2)=ABSV(""SITE""),$P(^(0),U,6)=ABSVX(""NAME"")" D ^DIC K DIC S DA=+Y
10 I LUN=0,DA>0 S X=$G(^ABS(503330.2,DA,0)) Q:X="" D QUIT
11 . I $P(X,"^",5)]"" QUIT
12 . I $P(X,"^",3)]"" K ^ABS(503330.2,"AD",$P(X,"^",3),DA)
13 . S ^ABS(503330.2,"AD",0,DA)="",$P(^ABS(503330.2,DA,0),"^",3)=0
14 . QUIT
15 QUIT:'LUN
16 I DA<1 S DIC="^ABS(503330.2,",DIC(0)="LMN",X=ABSVX("VOLDA"),DIC("DR")="1////"_ABSV("SITE")_";1.5////"_ABSVX("NAME")_";2////1;3////"_+DT D FILE^DICN K DIC S DA=+Y
17 Q:DA<1
18 S $P(^ABS(503330.2,DA,0),"^",2)=ABSV("SITE"),$P(^(0),"^",3)=LUN,$P(^(0),"^",4)=+DT,$P(^(0),"^",6)=$G(ABSVX("NAME")),^ABS(503330.2,"AC",+DT,DA)="",^ABS(503330.2,"AD",LUN,DA)="",LUNCH=1
19 I $P(ABSV("PARAM"),"^",12)=1 D
20 . I $P(^ABS(503330.2,DA,0),"^",5)="" D X^ABSVMT(ABSVX("NAME")) D NOW^ABSVQ S NOW=%,$P(^ABS(503330.2,DA,0),"^",5)=NOW QUIT
21 . S X="!"_$$GET^ABSVU1("MEAL TICKET PRINTED ALREADY",$S($D(PLANG):PLANG,1:1))_"*" D MSG^ABSVQ
22 Q
23EDL ;DELETE MEAL TICKET ENTRY FOR TODAY.
24 D ^ABSVSITE G:'% OUT
25E1 S DIC="^ABS(503330.2,",DIC(0)="AEMNQ",DIC("S")="I $P(^(0),U,4)=+DT,$P(^(0),U,2)=ABSV(""SITE"")"
26 I '$D(DIC("A")) S DIC("A")="Select VOLUNTEER: "
27 D MDIV^ABSVSITE,^DIC K DIC G OUT:+Y<0 S DA=+Y
28 S ABSVXA="OK to delete meal ticket for "_$$FULLDAT^ABSVU2(DT)_" for "_$P($G(^ABS(503330,+$P(Y,"^",2),0)),"^"),ABSVXB="",%=1 D ^ABSVYN
29 S ABSVXA=% I %'=1 S X=" <No action taken>*" D MSG^ABSVQ
30 G:ABSVXA<0 OUT
31 I ABSVXA=1 D
32 . S DIK="^ABS(503330.2," D ^DIK K DIK,DA
33 . S X=" <Entry Deleted>*" D MSG^ABSVQ
34 . QUIT
35 D E2 G E1
36E2 S DIC("A")="Select Next Volunteer: " Q
37ADD ;ADD A NEW ENTRY
38 D ^ABSVSITE G:'% OUT
39A1 I '$D(DIC("A")) S DIC("A")="Select VOLUNTEER: "
40 S DIC=503330,DIC(0)="AMNQE"
41 F D MDIV^ABSVSITE,^DIC G OUT:+Y<0 Q:$$ACTIVE^ABSVU2(+Y,ABSV("INST"))
42 K DIC G:+Y<0 OUT
43 I '$D(^ABS(503330,+Y,4,ABSV("INST"),0)) S X="This Volunteer is not currently registered as an active volunteer for Station "_ABSV("SITE")_". <No Action Taken>*" D MSG^ABSVQ,A2 G A1
44 S ABSVX("VOLDA")=+Y,ABSVX("SSN")=$P(^ABS(503330,+Y,0),"^",2),ABSVX("NAME")=$P(^(0),"^",1)
45 I ABSVX("NAME")="UNSCHEDULED,VOLUNTEER" D UNSCHED I $G(X)="ABORT" K X QUIT
46 S DIC="^ABS(503330.2,",DIC(0)="M",X=$S(ABSVX("SSN")]"":ABSVX("SSN"),1:ABSVX("NAME"))
47 S DIC("S")="I $P(^(0),U,2)=ABSV(""SITE""),$P(^(0),U,4)=+DT,$P(^(0),U,6)=ABSVX(""NAME"")"
48 D ^DIC S DA=+Y K DIC
49 I +Y<0 D LUN(1)
50 I $P(ABSV("PARAM"),"^",12)=1,$P($G(^ABS(503330.2,DA,0)),"^",5)]"" D ASK W !
51 S X=" --- Finished ---*" D MSG^ABSVQ
52 D A2 G A1
53UNSCHED S DIR("A")="Select Unscheduled Volunteer Name: ",DIR(0)="FAU^3:30^S X=$$UPPER^ABSVU2(X) W "" "",X K:X'?1.A1"","".A X"
54 S DIR("?")="Enter a name in the format LAST,FIRST. " D ^DIR I $$DIR^ABSVU2 S X="ABORT" QUIT
55 S ABSVXA="OK to add "_X_" to the list",ABSVXB="",%=1 W ! D ^ABSVYN
56 I %<0 S X="ABORT" QUIT
57 I %=1 S ABSVX("NAME")=Y K X QUIT
58 W !! G UNSCHED
59A2 S DIC("A")="Add next VOLUNTEER:" Q
60ASK S ABSVXA="A meal ticket has already been printed for this volunteer for today.",ABSVXA(1)="OK TO REPRINT",ABSVXB="" D ^ABSVYN
61 I %'=1 S X=" <No action taken>*" D MSG^ABSVQ QUIT
62 D X^ABSVMT(ABSVX("NAME"),1)
63 QUIT
64OUT K %,%W,%X,%Y,%Y1,ABSVX("VOLDA"),ABSVX("NAME"),ABSVX("SSN"),ABSVXA,C,D0,DA,DDH,DI,DIC,DIE,DQ,DR,I,X,Y,DA Q
Note: See TracBrowser for help on using the repository browser.