source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVL.m@ 1710

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1ABSVL ;VAMC ALTOONA/CTB&CLH - LOG (IN/OUT) VOLUNTEER ;3/10/99 7:42 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**1,3,6,7,10,13,15**;JULY 1994;
3EN K ZTQUEUED
4 I '$D(DT) D NOW^%DTC S DT=X
5 S ABSVX("NOWRITE")="" I '$D(ABSV("SITE")) D ^ABSVSITE Q:'%
6 S (ABSVDL,ABSVAL)=1
7 I +$P(ABSV("PARAM"),"^",8) D
8 . S ABSVDL=$S($P(ABSV("PARAM"),"^",10):$P(ABSV("PARAM"),"^",10),1:1)
9 . S ABSVAL=$S($P(ABSV("PARAM"),"^",11):$P(ABSV("PARAM"),"^",11),1:1)
10 . QUIT
11 S DTIME=300,LH=$E($P(^ABS(503338,ABSV("INST"),0),"^",7),1,4)
12 S RH=+$P(^ABS(503338,ABSV("INST"),0),"^",6)
13RESET K NEW S PLANG=ABSVDL,ALTLANG=ABSVAL
14EN1 D NOW^%DTC S DT=X
15 K LUNCH
16 W:$D(IOF) @IOF
17 W !!,$$GET^ABSVU1("WELCOME TO VATS",PLANG)
18 I +$P(ABSV("PARAM"),"^",8) S X="!! ("_$$GET^ABSVU1("READ IN ENGLISH",ALTLANG)_")" D MSG^ABSVQ
19 S X="!!"_$$GET^ABSVU1("ENTER CODE",PLANG) D MSG^ABSVQ W !
20 X ^%ZOSF("EOFF")
21 W !,$$GET^ABSVU1("CODE",PLANG) R X:120 S:'$T ABS("$T")=""
22 X ^%ZOSF("EON")
23 S X=$$UPPER^ABSVU2(X)
24 G:X="*^*" ASK^ABSVL2
25 I $E(X,1,3)="EEE" S X=PLANG,PLANG=ALTLANG,ALTLANG=X,RESETL="" G EN1
26 I X'?1U4N,X'?9N,'$D(ABS("$T")) S X=$$GET^ABSVU1("ASK SSN",PLANG) D MSG^ABSVQ R X:3 G OUT
27 I X="",$$HALT^ABSVLS K ABS("$T"),^ABS("ABSVKILL",ABSV("SITE"),IO) W @IOF,"VOLUNTARY SERVICE PROGRAM STOPPED" G H^XUS
28 I $D(ABS("$T")) K ABS("$T") D ^ABSVLS1 G OUT
29 S DIC=503330,DIC(0)="MZE",D="C" D IX^DIC K DIC
30 I Y<0 S X=$$GET^ABSVU1("CODE INVALID - TRY AGAIN",PLANG)_"*" D MSG^ABSVQ R X:3 G OUT
31 S ABSVX("VOLDA")=+Y,ABSVX("NAME")=$P(Y,"^",2),ABSVX("SSN")=$P(Y(0),"^",2)
32 I $D(RESETL) D
33 . S X=$P(Y(0),"^",11) S X=$S(X="":PLANG,1:ALTLANG),$P(Y(0),"^",11)=X,$P(^ABS(503330,ABSVX("VOLDA"),0),"^",11)=X K RESETL
34 . QUIT
35 I $P(Y(0),"^",11)]"" S PLANG=$P(Y(0),"^",11)
36 S X=$S($P(Y(0),"^",9)]"":$P(Y(0),"^",9),1:$P($P(ABSVX("NAME"),",",2)," ")) F %=2:1:$L(X) I $E(X,%)?1U,$E(X,%-1)?1A S X=$E(X,0,%-1)_$C($A(X,%)+32)_$E(X,%+1,999)
37 S ABSVX("NICK")=X
38 D NOW^ABSVQ S X=+$P(%,".",2),X=$S(X<1200:33,X>1700:35,1:34)
39 S X="!!"_$$GET^ABSVU1(X,PLANG)_", "_ABSVX("NICK")_"*!" D MSG^ABSVQ
40 I '$D(^ABS(503330,ABSVX("VOLDA"),4,ABSV("INST"),0)) S X=$$GET^ABSVU1("NO COMBINATIONS",PLANG,ABSV("SITE"))_"*" D MSG^ABSVQ R X:15 G RESET
41 I $P(^ABS(503330,ABSVX("VOLDA"),4,ABSV("INST"),0),"^",8)]"" S X=$$GET^ABSVU1("NOT ACTIVE",PLANG)_"*!" D MSG^ABSVQ R X:15 G OUT
42ED K DONE F ZI=1:1:3 D I $D(DONE) K DONE QUIT
43 . D PC1^ABSVE2 S:'$D(ABSVX("LIST")) ABSVOUT=1 I '$D(ABSVX("LIST")) S DONE=1 QUIT
44 . D SEL1^ABSVE2 I Y]""!$E($G(ABSVOUT),1,2)!$E($G(ABSVOUT),4) S DONE=1 QUIT
45 . S X=$$GET^ABSVU1("MUST SELECT",PLANG)_"*" D MSG^ABSVQ
46 . I ZI=3 S X=$$GET^ABSVU1("START OVER",PLANG)_"*" D MSG^ABSVQ S DONE=1 QUIT
47 . QUIT
48 K ABSVX("LIST") I ABSVOUT K ABSVOUT S X=" <"_$$GET^ABSVU1("LOGIN NOT COMPLETED",PLANG)_">*" D MSG^ABSVQ R X:5 G OUT
49 S COMB=$P(Y,"^",2),FULLCOMB=$P($G(^ABS(503330,ABSVX("VOLDA"),1,COMB,0)),"^",5)
50 S (DIC,DLAYGO)=503330.1,DIC(0)="NLMZ",X=ABSVX("SSN") S:'$D(DIC("S")) DIC("S")="S ZX=^(0) I X=$P(ZX,U),$P(ZX,U,9)=ABSV(""SITE""),$P(ZX,U,3)=COMB,$P(ZX,U,2)=$P(DT,""."")" D ^DIC K DIC S ABSVX("LDA")=+Y,DA=+Y,NEW=$P(Y,"^",3)
51 I Y<0 S X=$$GET^ABSVU1("CONFUSED",PLANG)_"*" D MSG^ABSVQ R X:5 G OUT
52 I 'NEW D I $D(POINT) S X=POINT K POINT G @X
53 . K POINT
54 . S ABSVXA=$$GET^ABSVU1("ALREADY LOGGED",PLANG),ABSVXA(1)=$$GET^ABSVU1("WISH TO CHANGE",PLANG),ABSVXB=$$GET^ABSVU1("YES OR NO",PLANG,"'^'"),%=2
55 . D ^ABSVYN
56 . I %<0 S X=$$GET^ABSVU1("START OVER",PLANG)_"*" D MSG^ABSVQ R X:2 S POINT="OUT" QUIT
57 . QUIT:%=1
58 . S ABSVXA=$$GET^ABSVU1("ANOTHER ORG/SERV",PLANG),ABSVXB=$$GET^ABSVU1("YES OR NO",PLANG),%=2
59 . D ^ABSVYN
60 . I %=1 S DIC("S")="I $P(^(0),U,3)=COMB,$P(^(0),U,9)=ABSV(""SITE"")" S POINT="ED" QUIT
61 . S POINT="RESET"
62 . QUIT
63 F D QUES^ABSVL1 Q:(+Y)!(X)
64 I X["^" S X=$$GET^ABSVU1("LOGIN NOT COMPLETED",PLANG)_"*" D MSG^ABSVQ S DIK="^ABS(503330.1," D ^DIK K DIK G OUT
65 S (TH,HOURS)=+Y
66 D TIME^ABSVL2 S LUNCH=""
67 I $D(ABSVX("M")) D LUNCH^ABSVL1
68 S DIE="^ABS(503330.1,",DR="[ABSV LOG]" D ^DIE
69 I $D(Y) S DIK="^ABS(503330.1," D ^DIK K DIE,DIC,DA W !! S X=" ----- "_$$GET^ABSVU1("ENTRY DELETED",PLANG)_" ------*" D MSG^ABSVQ G OUT
70 S X="!!"_$$GET^ABSVU1("LOGIN COMPLETE",PLANG)_"*" D MSG^ABSVQ
71 I $G(LUNCH),$P(^ABS(503338,ABSV("INST"),0),"^",5)]"",$D(ABSVX("M")) S X="!!"_$$GET^ABSVU1("DISPLAY MEAL REMINDER",PLANG,$J($P(^(0),"^",5),0,2))_"*" D MSG^ABSVQ R X:10
72 W !,$$GET^ABSVU1("QUESTIONS",PLANG) R X:10
73OUT K ST,QT,TH,X,ZZ,ZZ2,DIC,DIE,REC,ZZ1,ZZ3,DR,DA,DIC,DLAYGO,ABSVX("LIST"),ABSVOUT,ABSVX("LDA"),ABSVX("T"),ABSVX("M"),ABSVX("VOLDA"),HOURS,LUNCH G RESET
Note: See TracBrowser for help on using the repository browser.