| [613] | 1 | ABSVL2 ;VAMC ALTOONA/CTB - MISC VOL LOG-IN SUBROUTINES ;4/4/00 9:37 AM
|
|---|
| 2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**7,15,18**;JULY 6, 1994
|
|---|
| 3 | TIME K ABSVX("T"),ABSVX("M")
|
|---|
| 4 | N X,Y,%T,ABSVXX,DOW
|
|---|
| 5 | D NOW^ABSVQ I DT'=X S DT=X
|
|---|
| 6 | D DOW^%DTC S DOW=$S(Y=6:"SAT",Y=0:"SUN",$D(^HOLIDAY(X)):"HOL",1:"WEEKDAY")
|
|---|
| 7 | S X=$TR($P(ABSVXX,"@",2),":")
|
|---|
| 8 | ;I X<LH,TH>RH S ABSVX("M")=1
|
|---|
| 9 | I X>LH QUIT
|
|---|
| 10 | I RH>TH QUIT
|
|---|
| 11 | I DOW="SAT",+$P(ABSV("PARAM"),"^",14)=0 QUIT
|
|---|
| 12 | I DOW="SUN",+$P(ABSV("PARAM"),"^",15)=0 QUIT
|
|---|
| 13 | I DOW="HOL",+$P(ABSV("PARAM"),"^",16)=0 QUIT
|
|---|
| 14 | S ABSVX("M")=1 Q
|
|---|
| 15 | ASK S ABSVXA="Do you want to transfer Temporary Log to Daily Time File now",ABSVXB="",%=2 D ^ABSVYN G:%'=1 H^XUS
|
|---|
| 16 | S ABSVXA="Are you sure",ABSVXB="",%=1 D ^ABSVYN G:%'=1 H^XUS
|
|---|
| 17 | D ^ABSVNIT1
|
|---|
| 18 | G H^XUS
|
|---|
| 19 | QUIT
|
|---|
| 20 | LIST ;list volunteers on auto log-in for one day.
|
|---|
| 21 | D ^ABSVSITE Q:'%
|
|---|
| 22 | S L=0,DIC=503330.1,(FR,TO)="TODAY",DIS(0)="I $P(^ABS(503330.1,D0,0),U,9)=ABSV(""SITE"")",(BY,FLDS)="[ABSV STATION LIST]" D EN1^DIP
|
|---|
| 23 | QUIT
|
|---|
