Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSVL

ABSVL.m

Go to the documentation of this file.
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