44 lines
1.7 KiB
Mathematica
44 lines
1.7 KiB
Mathematica
ABSVLBL1 ;VAMC ALTOONA/CTB - PRINT VOLUNTEER LABEL ;3/1/00 10:58 AM
|
|
V ;;4.0;VOLUNTARY TIMEKEEPING;**18**;JULY 6, 1994
|
|
ONE(DA) ;print one label for volunteer DA
|
|
NEW NAME,NODE,ADD1,ADD2,CITY,STATE,ZIP,DR,X,DIC,LINE
|
|
W:IOSL-$Y<6 @IOF
|
|
Q:'$D(^ABS(503330,DA,0))
|
|
S NODE=$G(^ABS(503330,DA,0)) Q:NODE=""
|
|
S NAME=$P(NODE,"^",1),NAME=$P(NAME,",",2)_" "_$P(NAME,",")_$S($P(NAME,",",3,99)]"":", "_$P(NAME,",",3,99),1:"")
|
|
S ADD1=$P(NODE,"^",3),ADD2=$P(NODE,"^",10),CITY=$P(NODE,"^",4),STATE=$P(NODE,"^",5),ZIP=$P(NODE,"^",6)
|
|
I +STATE S X=$G(^DIC(5,STATE,0)),STATE=$S($P(X,"^",2)]"":$P(X,"^",2),$P(X,"^",1)]"":$P(X,"^",1),1:"") I 1
|
|
E S STATE=""
|
|
S LINE=2
|
|
W !,$$UPPER^ABSVU2(NAME) S LINE=LINE+1
|
|
I $L(ADD1) W !,$$UPPER^ABSVU2(ADD1) S LINE=LINE+1
|
|
I $L(ADD2) W !,$$UPPER^ABSVU2(ADD2) S LINE=LINE+1
|
|
S X=CITY_$S($L(CITY):", ",1:"")_STATE,X=$S($L(X):X_" ",1:"")_ZIP
|
|
W !,$$UPPER^ABSVU2(X) S LINE=LINE+1
|
|
F LINE=LINE:1:7 Q:IOSL-$Y<3 W !
|
|
QUIT
|
|
;
|
|
INPTR(X,DA) ;input transform for field 2 file 503339 (volunteer label)
|
|
I +X'=X!(X>8)!(X<1)!(X?.E1"."1N.N) K X QUIT
|
|
I $P($P(^ABS(503339,DA,0),"^",1)*X,".",2) K X
|
|
QUIT
|
|
AFFIL(D0,INST,SITE) ;function to validate affiliation for:
|
|
;D0 - IRN in 503334.1
|
|
;INST - INSTITUTION IRN
|
|
;SITE - SITE NUMBER
|
|
;ORG - ORGANIZATION IRN
|
|
;assumes affiliation for VACO
|
|
N ORG
|
|
I $D(^ABS(503334.1,"E","VACO",D0)) Q 1
|
|
S ORG=$P($G(^ABS(503334.1,D0,0)),"^",11) I ORG="" Q 0
|
|
I '$P($G(^ABS(503334.1,D0,0)),"^",10) Q 0
|
|
I $D(^ABS(503334.1,"E","USA",D0)),$D(^ABS(503338,"AB",ORG,INST)) Q 1
|
|
;W !,D0," ",INST," ",SITE," ",ORG
|
|
I $D(^ABS(503334.1,"E",SITE,D0)),$D(^ABS(503338,"AB",ORG,INST)) Q 1
|
|
Q 0
|
|
TEST D ^ABSVSITE
|
|
S DIC=503334.1,DIC(0)="AEMNZ" D ^DIC Q:'Y
|
|
S D0=+Y
|
|
S X=$$AFFIL(D0,ABSV("INST"),ABSV("SITE"))
|
|
W !,$S(X:"PASSED",1:"FAILED"),!! G TEST
|