| 1 | ABSVLBL1 ;VAMC ALTOONA/CTB - PRINT VOLUNTEER LABEL ;3/1/00 10:58 AM
|
|---|
| 2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**18**;JULY 6, 1994
|
|---|
| 3 | ONE(DA) ;print one label for volunteer DA
|
|---|
| 4 | NEW NAME,NODE,ADD1,ADD2,CITY,STATE,ZIP,DR,X,DIC,LINE
|
|---|
| 5 | W:IOSL-$Y<6 @IOF
|
|---|
| 6 | Q:'$D(^ABS(503330,DA,0))
|
|---|
| 7 | S NODE=$G(^ABS(503330,DA,0)) Q:NODE=""
|
|---|
| 8 | S NAME=$P(NODE,"^",1),NAME=$P(NAME,",",2)_" "_$P(NAME,",")_$S($P(NAME,",",3,99)]"":", "_$P(NAME,",",3,99),1:"")
|
|---|
| 9 | S ADD1=$P(NODE,"^",3),ADD2=$P(NODE,"^",10),CITY=$P(NODE,"^",4),STATE=$P(NODE,"^",5),ZIP=$P(NODE,"^",6)
|
|---|
| 10 | 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
|
|---|
| 11 | E S STATE=""
|
|---|
| 12 | S LINE=2
|
|---|
| 13 | W !,$$UPPER^ABSVU2(NAME) S LINE=LINE+1
|
|---|
| 14 | I $L(ADD1) W !,$$UPPER^ABSVU2(ADD1) S LINE=LINE+1
|
|---|
| 15 | I $L(ADD2) W !,$$UPPER^ABSVU2(ADD2) S LINE=LINE+1
|
|---|
| 16 | S X=CITY_$S($L(CITY):", ",1:"")_STATE,X=$S($L(X):X_" ",1:"")_ZIP
|
|---|
| 17 | W !,$$UPPER^ABSVU2(X) S LINE=LINE+1
|
|---|
| 18 | F LINE=LINE:1:7 Q:IOSL-$Y<3 W !
|
|---|
| 19 | QUIT
|
|---|
| 20 | ;
|
|---|
| 21 | INPTR(X,DA) ;input transform for field 2 file 503339 (volunteer label)
|
|---|
| 22 | I +X'=X!(X>8)!(X<1)!(X?.E1"."1N.N) K X QUIT
|
|---|
| 23 | I $P($P(^ABS(503339,DA,0),"^",1)*X,".",2) K X
|
|---|
| 24 | QUIT
|
|---|
| 25 | AFFIL(D0,INST,SITE) ;function to validate affiliation for:
|
|---|
| 26 | ;D0 - IRN in 503334.1
|
|---|
| 27 | ;INST - INSTITUTION IRN
|
|---|
| 28 | ;SITE - SITE NUMBER
|
|---|
| 29 | ;ORG - ORGANIZATION IRN
|
|---|
| 30 | ;assumes affiliation for VACO
|
|---|
| 31 | N ORG
|
|---|
| 32 | I $D(^ABS(503334.1,"E","VACO",D0)) Q 1
|
|---|
| 33 | S ORG=$P($G(^ABS(503334.1,D0,0)),"^",11) I ORG="" Q 0
|
|---|
| 34 | I '$P($G(^ABS(503334.1,D0,0)),"^",10) Q 0
|
|---|
| 35 | I $D(^ABS(503334.1,"E","USA",D0)),$D(^ABS(503338,"AB",ORG,INST)) Q 1
|
|---|
| 36 | ;W !,D0," ",INST," ",SITE," ",ORG
|
|---|
| 37 | I $D(^ABS(503334.1,"E",SITE,D0)),$D(^ABS(503338,"AB",ORG,INST)) Q 1
|
|---|
| 38 | Q 0
|
|---|
| 39 | TEST D ^ABSVSITE
|
|---|
| 40 | S DIC=503334.1,DIC(0)="AEMNZ" D ^DIC Q:'Y
|
|---|
| 41 | S D0=+Y
|
|---|
| 42 | S X=$$AFFIL(D0,ABSV("INST"),ABSV("SITE"))
|
|---|
| 43 | W !,$S(X:"PASSED",1:"FAILED"),!! G TEST
|
|---|
