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

ABSVSITE ;VAMC ALTOONA/CTB - RETURNS VARIABLE ABSV("SITE"),ABSV("PER") ;3/9/00  11:48 AM
V ;;4.0;VOLUNTARY TIMEKEEPING;**3,15,18**;JULY 6, 1994
 ;CHECK FOR STATION
 NEW %W,%Y,C,I,N,DIC,PROMPT
 D DUZ G:'% Q
 I $D(ABSV("SITENAME")) S PROMPT=ABSV("SITENAME")
 I '$D(DT) D NOW^%DTC S DT=X K %,%H,%I,ABSVXI,X
 W ! I '$D(^ABS(503338,0)) W "SITE PARAMETERS HAVE NOT YET BEEN ESTABLISHED, NO FURTHER PROCESSING CAN OCCUR",*7 G Q
 S U="^",B=^ABS(503338,0)
 S %=1 K ABSV("MDIV")
 S N=0 F I=0:1 Q:I>1  S N=$O(^ABS(503338,N)) Q:'N
 I I>1 S ABSV("MDIV")=""
 K ABSVX("LIST") S ABSVX("LIST")="",N=0 F ZI=1:1 S N=$O(^ABS(503338,N)) Q:'N  I $D(^ABS(503338,N,2,"B",DUZ)) S ABSVX("LIST")=ABSVX("LIST")+1,ABSVX("LIST",N)=""
 K ZI I ABSVX("LIST")="",'$D(ZTQUEUED) S X="You are not an authorized user of this Package.  Please contact your IRM or Voluntary Service for further assistance." D MSG^ABSVQ K ABSV G Q
 I ABSVX("LIST")=1 S ABSV("INST")=$O(ABSVX("LIST",0)) K:ABSV("INST")="" ABSV("INST") I $D(ABSV("INST")) K ABSV("MDIV") G S2
 I '$D(ABSV("INST")) S ABSV("INST")=$S($D(^ABS(503338,"AC",1))&($O(^(1,0))):$P(^ABS(503338,$O(^ABS(503338,"AC",1,0)),0),"^"),1:$P(^ABS(503338,$O(^ABS(503338,0)),0),U,1))
 S ABSV("SITE")=$P(^ABS(503338,ABSV("INST"),0),"^",9),ABSV("SITENAME")=$P(^DIC(4,ABSV("INST"),0),"^")
D1 ;
 I '$D(ABSV("MDIV")) S ABSV("INST")=$O(^ABS(503338,0)),ABSV("SITE")=$P(^ABS(503338,ABSV("INST"),0),"^",9),ABSV("SITENAME")=$P(^DIC(4,ABSV("INST"),0),"^") G SE1
 W ! S DIC("A")="Select STATION NUMBER ('^' TO EXIT): ",DIC("B")=$S($D(PROMPT):PROMPT,1:ABSV("SITENAME")),DIC="^ABS(503338,",DIC(0)="AEQM"
 D ^DIC K DIC G:+Y<0 Q S ABSV("INST")=+Y
S2 S ABSV("SITE")=$P(^ABS(503338,ABSV("INST"),0),"^",9),ABSV("SITENAME")=$P(^DIC(4,ABSV("INST"),0),"^")
SE1 I ABSV("SITE")="" S X="The VOL STATION NUMBER field in File 503338 is blank.  No Further Processing can take place without data in this field.  PLEASE CONTACT YOUR SITE MANAGER.*" D MSG^ABSVQ K ABSV G Q
 I '$D(^ABS(503338,ABSV("INST"),2,"B",DUZ)),'$D(ZTQUEUED) S X="You are not an AUTHORIZED USER for Station "_ABSV("SITE")_".  No futher actions can be taken.*" D MSG^ABSVQ G Q
 S ABSV("PARAM")=^ABS(503338,ABSV("INST"),0)
OUT S %=1 K %DT,DIC,ABSVX,%F,A,B,X,Y Q
 ;
Q K ABSV,ABSVX,ABSVB,%DT,DIC,%F,A,B,X,Y S %=0 Q
 ;
DUZ ;LOOKUP AND SET ABSV("PER")=PERSON FILE IRN
 S ABSV("PER")=DUZ
 K X S X=$S('$D(^VA(200,+ABSV("PER"),20)):"",1:^VA(200,+ABSV("PER"),20))
 S $P(ABSV("PER"),"^",2,4)=$P(X,"^",2)_"^"_$P(X,"^",3)_"^"_$S($D(^VA(200,+ABSV("PER"),.13)):$P(^(.13),"^",2),1:"")
 S %=1 QUIT
INIT ;PRIMARY INIT POINT FOR ABSV OPTIONS
 D DUZ Q:'%  I $D(DUZ(0)),$D(DT),$D(DTIME),+DT>0,+DTIME>0 Q
 D DT^DICRW Q
EX ;EXIT LINE FOR MENUMANAGER
 K ABSV,ABSVB,ABSVX Q
PRIMARY ;INPUT TRANSFORM FOR FILE 503338 FIELD 1 "PRIMARY STATION"
 N ABSVX,ABSVY,ABSVXA,ABSVXB,ABSVZ,N
 S ABSVX=X S ABSVY=$O(^ABS(503338,"AC",1,0))
 I $S('ABSVY:1,ABSVY=DA:1,1:0) Q
 S ABSVZ=$P(^ABS(503338,ABSVY,0),"^",9),ABSVXA="Station number "_ABSVZ_" has already been designated as 'PRIMARY'",ABSVXA(1)="OK to REPLACE",ABSVXB="",%=2 D ^ABSVYN I %'=1 D NA Q
 S ABSVXA="Are you sure you want to make STATION "_$P(^ABS(503338,DA,0),"^",9)_" as 'PRIMARY'",ABSVXB="",%=2 D ^ABSVYN I %'=1 D NA Q
 ;CLEAN UP CURRENT ENTRIES
 F N=0:0 S N=$O(^ABS(503338,"AC",1,0)) Q:'N  K ^(N) S $P(^ABS(503338,N,0),"^",2)=""
 S X=" <Primary Station Changed>*" D MSG^ABSVQ S X=1 Q
NA S X="<Primary Station Unchanged>" D MSG^ABSVQ S X=0 Q
MDIV ;
 N X
 ;W !
 I '$D(ABSV("MDIV")) QUIT
 Q:'$D(ABSV("SITE"))!('$D(ABSV("SITENAME")))
 W !,"For Station "_$S($D(ABSV("SITE")):ABSV("SITE"),1:ABSV("SITENAME")),","
 QUIT