57 lines
3.5 KiB
Mathematica
57 lines
3.5 KiB
Mathematica
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
|