VistA-WorldVistAEHR/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVL.m

74 lines
4.4 KiB
Mathematica

ABSVL ;VAMC ALTOONA/CTB&CLH - LOG (IN/OUT) VOLUNTEER ;3/10/99 7:42 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**1,3,6,7,10,13,15**;JULY 1994;
EN K ZTQUEUED
I '$D(DT) D NOW^%DTC S DT=X
S ABSVX("NOWRITE")="" I '$D(ABSV("SITE")) D ^ABSVSITE Q:'%
S (ABSVDL,ABSVAL)=1
I +$P(ABSV("PARAM"),"^",8) D
. S ABSVDL=$S($P(ABSV("PARAM"),"^",10):$P(ABSV("PARAM"),"^",10),1:1)
. S ABSVAL=$S($P(ABSV("PARAM"),"^",11):$P(ABSV("PARAM"),"^",11),1:1)
. QUIT
S DTIME=300,LH=$E($P(^ABS(503338,ABSV("INST"),0),"^",7),1,4)
S RH=+$P(^ABS(503338,ABSV("INST"),0),"^",6)
RESET K NEW S PLANG=ABSVDL,ALTLANG=ABSVAL
EN1 D NOW^%DTC S DT=X
K LUNCH
W:$D(IOF) @IOF
W !!,$$GET^ABSVU1("WELCOME TO VATS",PLANG)
I +$P(ABSV("PARAM"),"^",8) S X="!! ("_$$GET^ABSVU1("READ IN ENGLISH",ALTLANG)_")" D MSG^ABSVQ
S X="!!"_$$GET^ABSVU1("ENTER CODE",PLANG) D MSG^ABSVQ W !
X ^%ZOSF("EOFF")
W !,$$GET^ABSVU1("CODE",PLANG) R X:120 S:'$T ABS("$T")=""
X ^%ZOSF("EON")
S X=$$UPPER^ABSVU2(X)
G:X="*^*" ASK^ABSVL2
I $E(X,1,3)="EEE" S X=PLANG,PLANG=ALTLANG,ALTLANG=X,RESETL="" G EN1
I X'?1U4N,X'?9N,'$D(ABS("$T")) S X=$$GET^ABSVU1("ASK SSN",PLANG) D MSG^ABSVQ R X:3 G OUT
I X="",$$HALT^ABSVLS K ABS("$T"),^ABS("ABSVKILL",ABSV("SITE"),IO) W @IOF,"VOLUNTARY SERVICE PROGRAM STOPPED" G H^XUS
I $D(ABS("$T")) K ABS("$T") D ^ABSVLS1 G OUT
S DIC=503330,DIC(0)="MZE",D="C" D IX^DIC K DIC
I Y<0 S X=$$GET^ABSVU1("CODE INVALID - TRY AGAIN",PLANG)_"*" D MSG^ABSVQ R X:3 G OUT
S ABSVX("VOLDA")=+Y,ABSVX("NAME")=$P(Y,"^",2),ABSVX("SSN")=$P(Y(0),"^",2)
I $D(RESETL) D
. 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
. QUIT
I $P(Y(0),"^",11)]"" S PLANG=$P(Y(0),"^",11)
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)
S ABSVX("NICK")=X
D NOW^ABSVQ S X=+$P(%,".",2),X=$S(X<1200:33,X>1700:35,1:34)
S X="!!"_$$GET^ABSVU1(X,PLANG)_", "_ABSVX("NICK")_"*!" D MSG^ABSVQ
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
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
ED K DONE F ZI=1:1:3 D I $D(DONE) K DONE QUIT
. D PC1^ABSVE2 S:'$D(ABSVX("LIST")) ABSVOUT=1 I '$D(ABSVX("LIST")) S DONE=1 QUIT
. D SEL1^ABSVE2 I Y]""!$E($G(ABSVOUT),1,2)!$E($G(ABSVOUT),4) S DONE=1 QUIT
. S X=$$GET^ABSVU1("MUST SELECT",PLANG)_"*" D MSG^ABSVQ
. I ZI=3 S X=$$GET^ABSVU1("START OVER",PLANG)_"*" D MSG^ABSVQ S DONE=1 QUIT
. QUIT
K ABSVX("LIST") I ABSVOUT K ABSVOUT S X=" <"_$$GET^ABSVU1("LOGIN NOT COMPLETED",PLANG)_">*" D MSG^ABSVQ R X:5 G OUT
S COMB=$P(Y,"^",2),FULLCOMB=$P($G(^ABS(503330,ABSVX("VOLDA"),1,COMB,0)),"^",5)
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)
I Y<0 S X=$$GET^ABSVU1("CONFUSED",PLANG)_"*" D MSG^ABSVQ R X:5 G OUT
I 'NEW D I $D(POINT) S X=POINT K POINT G @X
. K POINT
. S ABSVXA=$$GET^ABSVU1("ALREADY LOGGED",PLANG),ABSVXA(1)=$$GET^ABSVU1("WISH TO CHANGE",PLANG),ABSVXB=$$GET^ABSVU1("YES OR NO",PLANG,"'^'"),%=2
. D ^ABSVYN
. I %<0 S X=$$GET^ABSVU1("START OVER",PLANG)_"*" D MSG^ABSVQ R X:2 S POINT="OUT" QUIT
. QUIT:%=1
. S ABSVXA=$$GET^ABSVU1("ANOTHER ORG/SERV",PLANG),ABSVXB=$$GET^ABSVU1("YES OR NO",PLANG),%=2
. D ^ABSVYN
. I %=1 S DIC("S")="I $P(^(0),U,3)=COMB,$P(^(0),U,9)=ABSV(""SITE"")" S POINT="ED" QUIT
. S POINT="RESET"
. QUIT
F D QUES^ABSVL1 Q:(+Y)!(X)
I X["^" S X=$$GET^ABSVU1("LOGIN NOT COMPLETED",PLANG)_"*" D MSG^ABSVQ S DIK="^ABS(503330.1," D ^DIK K DIK G OUT
S (TH,HOURS)=+Y
D TIME^ABSVL2 S LUNCH=""
I $D(ABSVX("M")) D LUNCH^ABSVL1
S DIE="^ABS(503330.1,",DR="[ABSV LOG]" D ^DIE
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
S X="!!"_$$GET^ABSVU1("LOGIN COMPLETE",PLANG)_"*" D MSG^ABSVQ
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
W !,$$GET^ABSVU1("QUESTIONS",PLANG) R X:10
OUT 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