source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVTED1.m@ 767

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1ABSVTED1 ;VAMC ALTOONA/CTB_CLH - TIME CARD EDIT ;8/3/98 9:30 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**10**;JULY 6, 1994
3OUT K %,%DT,%W,%X,%Y,%1,ABSVX("CREATE"),C,COMB,D,D0,DA,DA1,DI,DIC,DIE,DIK,DQ,DR,DUOUT,MONTH,NN,NAME,ORG,SER,VOL,TC,TC1,TC2,TC3,X,X1,Y
4 Q
5CREATE ;CREATE SINGLE TIME CARD
6 N %,%DT,%W,%X,%Y,%Y1,C,COMB,D,D0,DA,DA1,DI,DIC,DIE,DIK,DQ,DR,MONTH,NN,NAME,ORG,SER,VOL,TC,TC1,TC2,TC3,X,X1,Y
7 D ^ABSVSITE G:'% OUT
8C F S DIC=503330,DIC("A")="Select VOLUNTEER: ",DIC(0)="AEMQZ" D MDIV^ABSVSITE,^DIC G:+Y<0 OUT Q:$$ACTIVE^ABSVU2(+Y,ABSV("INST"))
9 K DIC S ABSVX("VOLDA")=+Y,DA=+Y,NAME=$P(Y(0),"^"),%DT="AEP",%DT("A")="Select MONTH/YEAR: " D ^%DT G:+Y<0 OUT S MONTH=$E(Y,1,5)_"00"
10 D PC1^ABSVE2,SEL1^ABSVE2 K ABSVX("LIST") I Y="" S X="<No Selection Made, Option Terminated>*" D MSG^ABSVQ K ABSVOUT G OUT
11 S X=^ABS(503330,DA,1,$P(Y,"^",2),0)
12 S COMB=$P(X,"^",5),ORG=$P(X,"^",2),SER=$P(X,"^",4) D WAIT^ABSVYN
13 S DIC=503335,DLAYGO=503335,X=NAME,DIC(0)="LM",DIC("S")="S ZZX=^(0) I $P(ZZX,U,5)=MONTH,$P(ZZX,U,12)=ABSV(""SITE""),$P(ZZX,U,2)=COMB" D ^DIC K DIC,ZZX S DA=+Y,VOL=$P(Y,"^",2)
14 I $P(Y,"^",3)'=1 G DMSG
15C1 S DIE="^ABS(503335,",DR="[ABSV CREATE]" D ^DIE K DIE
16 S ABSVXA="Do you want to edit this time card now",ABSVXB="",%=1 D ^ABSVYN I %=1 S ABSVX("CREATE")=1 D TC1^ABSVTED
17 S ABSVXA="Is this Time Card ready for Transmission",ABSVXB="",%=1 D ^ABSVYN
18 S X=$S(%=1:1,1:0) D STATUS^ABSVU
19 S ABSVXA="Do you wish to create another Time Card",ABSVXB="",%=1 D ^ABSVYN G OUT:%'=1 G C
20MERGE ;MERGE TIME CARDS
21 D ^ABSVSITE G:'% OUT
22 S %DT="AEP",%DT("A")="Select MONTH/YEAR: " D ^%DT G:+Y<0 OUT S MONTH=$E(Y,1,5)_"00"
23 S DIC=503330,DIC(0)="AEMQZ",DIC("A")="Select VOLUNTEER: ",DIC("S")="I $D(^ABS(503330,+Y,4,ABSV(""INST""),0))"
24 D MDIV^ABSVSITE,^DIC S DA=+Y K DIC G:+Y<0 OUT
25 S NAME=Y(0,0)
26 W !!,"First, select the primary time card. (The one which will remain!)"
27 S DIC=503335,DIC(0)="EMQ",X=NAME,DIC("S")="S ZZX=^(0) I $P(ZZX,U,5)=MONTH,$P(ZZX,U,6)<3,$P(ZZX,U,12)=ABSV(""SITE"")" D ^DIC K ZZX S DA=+Y K DIC G:+Y<0 OUT S TC1=$G(^ABS(503335,DA,1))
28 W !!,"Select time card to merge and delete: ",!! S DIC=503335,X=NAME,DIC(0)="EMQ",DIC("S")="I $P(^(0),U,5)=MONTH,$P(^(0),U,6)<3,+Y'=DA" D ^DIC S DA1=+Y
29 I DA1<0 W !!,*7,"Only one time card exists this time period.",!,"No further action can be taken.",!! G MERGE
30 S ABSVXA="I will now merge the two time cards and delete the second entry.",ABSVXA(1)="Are you sure you want to do this",ABSVXB="",%=2 D ^ABSVYN G:%'=1 OUT
31 S ABSVXA="ARE YOU SURE",ABSVXB="",%=1 D ^ABSVYN G:%'=1 OUT
32 S X="While I merge the two entries..." D WAIT^ABSVYN
33 S TC3="",TC2=$G(^ABS(503335,DA1,1)) F I=1:1:32 S X=$P(TC1,"^",I)+$P(TC2,"^",I) S:X=0 X="" S $P(TC3,"^",I)=X
34 S $P(^ABS(503335,DA,1),"^",1,32)=TC3 S DIK="^ABS(503335,",DA=DA1 D ^DIK G OUT
35 ;
36GET ;GET ORG AND TRANSFER ENTRIES
37 S DIC=503334,DIC(0)="AEMNQ" D ^DIC Q:Y<0
38 I '$D(^ABS(503335,"AD",+Y)) W !,"THERE ARE NO ENTRIES IN THE TIME CARD FILE FOR THIS ORGANIZATION",*7 G GET
39 S DA=+Y D WAIT^ABSVYN S N=0 F I=1:1 S N=$O(^ABS(503335,"AD",DA,N)) Q:'N S ^ABS(503335,"AG",1,N)=""
40 S DIC("A")="Select Next ORGANIZATION: " G GET
41 ;
42ENAME ;EDIT NAME IN MASTER FILE
43 NEW %,%W,%Y,%X,ABSVX,C,D0,DA,DI,DIC,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,DUOUT,I,N,X,Y
44 D ^ABSVSITE Q:'%
45E1 S DIC=503330,DIC(0)="AEMNQ" S:'$D(DIC("A")) DIC("A")="Select VOLUNTEER: " S DIC("S")="I $D(^ABS(503330,+Y,4,ABSV(""INST""),0))"
46 F D MDIV^ABSVSITE,^DIC Q:+Y<0 Q:$$ACTIVE^ABSVU2(+Y,ABSV("INST"))
47 K DIC Q:+Y<0
48 S DA=+Y,ABSVX("VOLDA")=DA,ABSVX("NAME")=$P(Y,"^",2)
49 D MORE
50 S DIE="^ABS(503330,",DR=".01" D ^DIE K DIE
51 I $P(^ABS(503330,DA,0),"^",1)'=ABSVX("NAME") S EDIT="" D TT88^ABSVE3
52 S DIC("A")="Select Next VOLUNTEER: " G E1
53 ;
54DMSG S X="-- TIME CARD ALREADY EXISTS FOR THIS VOLUNTEER. --*" D MSG^ABSVQ S ABSVXA="Are you sure you want to create another time card",ABSVXB="",%=2 D ^ABSVYN G:%'=1 C
55 W ! S ABSVXA=" You may create duplicate entries",ABSVXA(1)="ARE YOU SURE YOU WANT CONTINUE",ABSVXB="",%=2 D ^ABSVYN G:%'=1 C
56 G C1
57MORE I $P(^ABS(503330,DA,4,0),"^",4)>1 S X="This volunteer is registered at more than one station. REMEMBER to coordinate changes with the other station(s).*" D MSG^ABSVQ
58 Q
Note: See TracBrowser for help on using the repository browser.