source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVSITE.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1ABSVSITE ;VAMC ALTOONA/CTB - RETURNS VARIABLE ABSV("SITE"),ABSV("PER") ;3/9/00 11:48 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**3,15,18**;JULY 6, 1994
3 ;CHECK FOR STATION
4 NEW %W,%Y,C,I,N,DIC,PROMPT
5 D DUZ G:'% Q
6 I $D(ABSV("SITENAME")) S PROMPT=ABSV("SITENAME")
7 I '$D(DT) D NOW^%DTC S DT=X K %,%H,%I,ABSVXI,X
8 W ! I '$D(^ABS(503338,0)) W "SITE PARAMETERS HAVE NOT YET BEEN ESTABLISHED, NO FURTHER PROCESSING CAN OCCUR",*7 G Q
9 S U="^",B=^ABS(503338,0)
10 S %=1 K ABSV("MDIV")
11 S N=0 F I=0:1 Q:I>1 S N=$O(^ABS(503338,N)) Q:'N
12 I I>1 S ABSV("MDIV")=""
13 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)=""
14 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
15 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
16 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))
17 S ABSV("SITE")=$P(^ABS(503338,ABSV("INST"),0),"^",9),ABSV("SITENAME")=$P(^DIC(4,ABSV("INST"),0),"^")
18D1 ;
19 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
20 W ! S DIC("A")="Select STATION NUMBER ('^' TO EXIT): ",DIC("B")=$S($D(PROMPT):PROMPT,1:ABSV("SITENAME")),DIC="^ABS(503338,",DIC(0)="AEQM"
21 D ^DIC K DIC G:+Y<0 Q S ABSV("INST")=+Y
22S2 S ABSV("SITE")=$P(^ABS(503338,ABSV("INST"),0),"^",9),ABSV("SITENAME")=$P(^DIC(4,ABSV("INST"),0),"^")
23SE1 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
24 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
25 S ABSV("PARAM")=^ABS(503338,ABSV("INST"),0)
26OUT S %=1 K %DT,DIC,ABSVX,%F,A,B,X,Y Q
27 ;
28Q K ABSV,ABSVX,ABSVB,%DT,DIC,%F,A,B,X,Y S %=0 Q
29 ;
30DUZ ;LOOKUP AND SET ABSV("PER")=PERSON FILE IRN
31 S ABSV("PER")=DUZ
32 K X S X=$S('$D(^VA(200,+ABSV("PER"),20)):"",1:^VA(200,+ABSV("PER"),20))
33 S $P(ABSV("PER"),"^",2,4)=$P(X,"^",2)_"^"_$P(X,"^",3)_"^"_$S($D(^VA(200,+ABSV("PER"),.13)):$P(^(.13),"^",2),1:"")
34 S %=1 QUIT
35INIT ;PRIMARY INIT POINT FOR ABSV OPTIONS
36 D DUZ Q:'% I $D(DUZ(0)),$D(DT),$D(DTIME),+DT>0,+DTIME>0 Q
37 D DT^DICRW Q
38EX ;EXIT LINE FOR MENUMANAGER
39 K ABSV,ABSVB,ABSVX Q
40PRIMARY ;INPUT TRANSFORM FOR FILE 503338 FIELD 1 "PRIMARY STATION"
41 N ABSVX,ABSVY,ABSVXA,ABSVXB,ABSVZ,N
42 S ABSVX=X S ABSVY=$O(^ABS(503338,"AC",1,0))
43 I $S('ABSVY:1,ABSVY=DA:1,1:0) Q
44 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
45 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
46 ;CLEAN UP CURRENT ENTRIES
47 F N=0:0 S N=$O(^ABS(503338,"AC",1,0)) Q:'N K ^(N) S $P(^ABS(503338,N,0),"^",2)=""
48 S X=" <Primary Station Changed>*" D MSG^ABSVQ S X=1 Q
49NA S X="<Primary Station Unchanged>" D MSG^ABSVQ S X=0 Q
50MDIV ;
51 N X
52 ;W !
53 I '$D(ABSV("MDIV")) QUIT
54 Q:'$D(ABSV("SITE"))!('$D(ABSV("SITENAME")))
55 W !,"For Station "_$S($D(ABSV("SITE")):ABSV("SITE"),1:ABSV("SITENAME")),","
56 QUIT
Note: See TracBrowser for help on using the repository browser.