[613] | 1 | ABSVE4 ;VAMC ALTOONA/CTB/CLH - MULTIPLE DAYS ENTRY ;4/13/00 3:17 PM
|
---|
| 2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**10,18**;JULY 6, 1994
|
---|
| 3 | ;ENTER DATA INTO TIME FILE
|
---|
| 4 | N %,%DT,%T,%W,%Y,C,COMB,DATE,DAY,DIC,DI,DIR,D0,DQ,DR,DUOUT,DIE,DATE,ORG,DA,SER,VOL,I,N,X,Y,POP,MONTH,DONE,OUT,DDH
|
---|
| 5 | D ^ABSVSITE G OUT^ABSVE3:'%
|
---|
| 6 | S (DONE,OUT)=0
|
---|
| 7 | F D Q:DONE I 'DONE!(OUT) G OUT^ABSVE3
|
---|
| 8 | . S %DT="AEP",%DT("A")="Select Posting MONTH and YEAR: " D ^%DT K %DT
|
---|
| 9 | . I Y>0 S DONE=1 QUIT
|
---|
| 10 | . I X["^" S OUT=1 QUIT
|
---|
| 11 | . S %DT="EX",X="??" W " Month and Year are REQUIRED. Use '^' to Quit",*7,!! D ^%DT S %DT="AEX"
|
---|
| 12 | . QUIT
|
---|
| 13 | I OUT K OUT D OUT^ABSVE3 QUIT
|
---|
| 14 | K DONE
|
---|
| 15 | S MONTH=$E(Y,1,5)_"00"
|
---|
| 16 | S DIC("A")="Select Volunteer: "
|
---|
| 17 | TIME S DIC("S")="I $D(^ABS(503330,+Y,4,ABSV(""INST""),0))",DIC=503330,DIC(0)="AEMZQ"
|
---|
| 18 | D MDIV^ABSVSITE,^DIC K DIC
|
---|
| 19 | G OUT^ABSVE3:Y<0
|
---|
| 20 | G TIME:'$$ACTIVE^ABSVU2(+Y,ABSV("INST"))
|
---|
| 21 | S ABSVX("VOLDA")=+Y,ABSVX("NAME")=$P(Y,"^",2)
|
---|
| 22 | T1 S DA=ABSVX("VOLDA") D PC1^ABSVE2,SEL1^ABSVE2 G OUT^ABSVE3:Y=""
|
---|
| 23 | S X=^ABS(503330,DA,1,$P(Y,"^",2),0)
|
---|
| 24 | S COMB=$P(X,"^",5),ORG=$P(X,"^",2),SER=$P(X,"^",4)
|
---|
| 25 | F D Q:DONE!(OUT)
|
---|
| 26 | . W !! S %DT="E",DONE=0,OUT=0 F D Q:DONE
|
---|
| 27 | . . NEW NEW
|
---|
| 28 | . . W !,"For "_ABSVX("NAME")_" and Combination "_COMB
|
---|
| 29 | . . R !,"Select DAY NUMBER: ",X:DTIME S %T=$T
|
---|
| 30 | . . I X=""!(X["^") S DONE=1 S:X["^"!('%T) OUT=1 QUIT
|
---|
| 31 | . . I X>31!(X<1) D ERROR QUIT
|
---|
| 32 | . . S X="0"_X,X=$E(MONTH,1,5)_$E(X,$L(X)-1,$L(X))
|
---|
| 33 | . . D ^%DT I Y'>0 D ERROR QUIT
|
---|
| 34 | . . S DATE=Y
|
---|
| 35 | . . S Y=0 F S Y=$O(^ABS(503331,"B",ABSVX("VOLDA"),Y)) Q:Y="" S X=$G(^ABS(503331,Y,0)) I $P(X,"^",3)=DATE,$P(X,"^",6)=COMB Q
|
---|
| 36 | . . I Y'>0 S X=ABSVX("VOLDA") S DIC="^ABS(503331,",DIC(0)="ML" D FILE^DICN,XREF S NEW=1
|
---|
| 37 | . . S DA=+Y,DR=4,DIE="503331" D ^DIE
|
---|
| 38 | . . I '$D(Y) S X="<Daily Record Completed.>*" D MSG^ABSVQ QUIT
|
---|
| 39 | . . I $D(NEW) K NEW S X="This entry is incomplete and is being deleted.*" D MSG^ABSVQ S DIK=DIE D ^DIK K DIK QUIT
|
---|
| 40 | . . S ABSVXA="ARE YOU SURE YOU WANT TO DELETE THIS ENTRY",ABSVXB="",%=1 D ^ABSVYN
|
---|
| 41 | . . I %'=1 S X=" <No action taken>*" D MSG^ABSVQ QUIT
|
---|
| 42 | . . S DIK=DIE D ^DIK K DIK S X=" <Record Deleted>*" D MSG^ABSVQ
|
---|
| 43 | . . QUIT
|
---|
| 44 | . QUIT:OUT
|
---|
| 45 | K OUT,DONE W !!!,"For ",$$FULLDAT^ABSVU2(MONTH),":" S DIC("A")="Select Next Volunteer: " G TIME
|
---|
| 46 | XREF S XX=$E(DATE,1,5)_"00^"_DATE_"^"_+ORG_"^^"_COMB_"^"_ABSV("SITE")_"^"_+SER,$P(^ABS(503331,+Y,0),"^",2,8)=XX K XX
|
---|
| 47 | S ^ABS(503331,"AD",DATE,+Y)="",^ABS(503331,"AC",+ORG,+Y)="",^ABS(503331,"AE",+SER,+Y)="",^ABS(503331,"AF",$E(DATE,1,5)_"00",+Y)=""
|
---|
| 48 | Q
|
---|
| 49 | ERROR ;
|
---|
| 50 | W *7,! S X="Enter the day NUMBER of the month selected. E.g. for March 25, 1993 enter 25, or '^' when finished.*"
|
---|
| 51 | D MSG^ABSVQ W !
|
---|
| 52 | QUIT
|
---|