source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVTED.m@ 1639

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1ABSVTED ;VAMC ALTOONA/CTB - TIME CARD EDIT ;9/4/97 3:51 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7**;JULY 6, 1994
3OUT K %,%DT,%W,%X,%Y,%Y1,C,D,D0,DA,DDC,DDH,DI,DIC,DIE,DIK,DQ,DR,DUOUT,I,MONTH,NAME,TC,X,X1,Y,ABSVY
4 QUIT
5MARK G ^ABSVTED3
6STATUS ;CHANGE TRANSMISSION STATUS OF TIME CARD
7 I '$D(X),'$D(DA) Q
8 S TC=$P(^ABS(503335,DA,0),"^",1,99) I $P(TC,"^",6)="" S ABSVXA="This time card does not have a valid transmission status. Should I mark it READY FOR TRANSMISSION",ABSVXB="",%=1 D ^ABSVYN Q:%'=1
9 D WAIT^ABSVYN
10 S X1=$P(TC,"^",6),$P(^ABS(503335,DA,0),"^",6)=X K ^ABS(503335,"AF",X1,DA) S ^ABS(503335,"AF",X,DA)=""
11 S X=" --Done--" D MSG^ABSVQ Q
12SUS ;SUSPEND TIME CARD TRANSMISSION
13 D ^ABSVSITE G OUT:'%
14SUS1 S DIC=503335,DIC(0)="AFEMQ",DIC("S")="I $P(^(0),U,6)=1,$P(^(0),U,12)=ABSV(""SITE"")",DIC("A")="Suspend time card for VOLUNTEER: "
15 F D MDIV^ABSVSITE,^DIC G:+Y<0 OUT Q:$$ACTIVE^ABSVU2(+$P(Y,"^",2),ABSV("INST"))
16 K DIC S DA=+Y
17 S ABSVXA="Do you want to SUSPEND transmission on this volunteer's time card",ABSVXB="",%=1 D ^ABSVYN G:%<0 OUT G:%'=1 SUS1
18 S X=0 D STATUS^ABSVU
19 S DIE="^ABS(503335,",DR="37///@" D ^DIE K DIE
20 S ABSVXA="Suspend another time card",ABSVXB="",%=1 D ^ABSVYN G:%'=1 OUT G SUS1
21REL ;RELEASE SUSPENDED TIME CARD
22 D ^ABSVSITE G OUT:'%
23 S DIC=503335,DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,6)=0,$P(^(0),U,12)=ABSV(""SITE"")",DIC("A")="Release suspended time card for VOLUNTEER: "
24 F D MDIV^ABSVSITE,^DIC G:+Y<0 OUT Q:$$ACTIVE^ABSVU2($P(Y,"^",2),ABSV("INST"))
25 K DIC S DA=+Y
26 S ABSVXA="Are you sure you want to RELEASE this volunteer's time card",ABSVXB="",%=1 D ^ABSVYN G:%'=1 REL S X=1 D STATUS^ABSVU
27 W ! S ABSVXA="Do you wish to backdate this card",ABSVXB="",%=1
28 D ^ABSVYN Q:%<0
29 I %=1 S DIE="^ABS(503335,",DR="37///BD" D ^DIE K DIE S X=" <Backdate Added>" D MSG^ABSVQ
30 W ! S ABSVXA="Release another time card",ABSVXB="",%=1 D ^ABSVYN G:%'=1 OUT G REL
31 QUIT
32BD ;BACKDATE A TIMECARD
33 S ABSVY("BACKDATE")=""
34H ;EDIT COLUMNS 49 & 50 ON TIME CARD
35 D ^ABSVSITE G:'% OUT
36H1 S DIC=503335,DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,6)<2,$P(^(0),U,12)=ABSV(""SITE"")",DIC("A")="Select VOLUNTEER: "
37 D MDIV^ABSVSITE,^DIC G:+Y<0 OUT K DIC S DA=+Y
38 I $P(^ABS(503335,DA,0),U,6)>1 W !!,*7,"*** TIME CARD HAS BEEN TRANSMITTED. NO FURTHER EDITING ALLOWED ***",!! G H
39 S DIE="^ABS(503335,",DR=$S($D(ABSVY("BACKDATE")):"37///BD",1:"[ABSV HOSP USE ONLY]") D ^DIE
40 I $D(ABSVY("BACKDATE")) W " --Done--",*7,!
41 K DIE G H1
42TC ;EDIT ENTIRE TIME CARD.
43 Q:$D(ABSVX("CREATE")) D ^ABSVSITE G OUT:'%
44TC2 S DIC=503335,DIC(0)="AEMQ",DIC("A")="Edit time card for VOLUNTEER: ",DIC("S")="I $P(^ABS(503335,+Y,0),U,6)<3,$P(^(0),U,12)=ABSV(""SITE"")"
45 F D MDIV^ABSVSITE,^DIC G:+Y<0 OUT Q:$$ACTIVE^ABSVU2(+$P(Y,U,2),ABSV("INST"))
46 K DIC S DA=+Y
47TC1 S DIE="^ABS(503335,",DR="[ABSV TIME CARD EDIT]" D ^DIE K DIE
48 S Y=0 I $D(^ABS(503335,DA,1)) S X=^(1),Y=0 F I=1:1:31 S Y=Y+$P(X,"^",I)
49 I Y=$P(X,"^",32) W !,"No Change in Total Hours.",!
50 E W !,"New Total Hours for this card is: ",Y,! S $P(^ABS(503335,DA,1),"^",32)=Y
51 I $D(ABSVX("MRT")) K ABSVX("MRT") Q
52 Q:$D(ABSVX("CREATE"))
53 S ABSVXA="Mark time card for READY FOR TRANSMISSION",ABSVXB="",%=1 D ^ABSVYN G:%'=1 TC S X=1 D STATUS^ABSVU G TC2
54DELSUS ;DELETE SUSPENDED TIME CARD
55 D ^ABSVSITE G:'% OUT
56 S DIC=503335,DIC(0)="AEMNQ",DIC("S")="I $P(^(0),U,6)=0,$P(^(0),U,12)=ABSV(""SITE"")",DIC("A")="Delete suspended time card for VOLUNTEER: "
57 D MDIV^ABSVSITE,^DIC K DIC G:+Y<0 OUT S DA=+Y
58 S ABSVXA="Are you sure you want to delete this time card",ABSVXB="",%=1 D ^ABSVYN G:%'=1 DELSUS
59 S ABSVXA="ARE YOU SURE YOU WANT TO DO THIS",ABSVXB="",%=2 D ^ABSVYN G:%'=1 DELSUS
60 S DIK="^ABS(503335," D ^DIK S X=" -- SUSPENDED TIME CARD HAS BEEN DELETED --*" D MSG^ABSVQ K DIK
61 S ABSVXA="Delete another suspended time card",ABSVXB="",%=2 D ^ABSVYN G:%'=1 OUT K DA G DELSUS
Note: See TracBrowser for help on using the repository browser.