| [613] | 1 | ABSVBGMF ;VAMC ALTOONA/CTB - UPDATE SEX OF VOLUNTEER ;9/1/99 11:04 PM
|
|---|
| 2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**17**;JULY 6, 1994
|
|---|
| 3 | ;UPDATE SEX CODE FOR ALL VOLUNTEERS
|
|---|
| 4 | N N,DA,%T,CHANGE
|
|---|
| 5 | S (CHANGE,N)="" F S N=$O(^ABS(503330,"B",N)) Q:N="" D
|
|---|
| 6 | . S DA="" F S DA=$O(^ABS(503330,"B",N,DA)) Q:'DA D
|
|---|
| 7 | . . N X,X1,SEX,NODE,BIRTHDAY,AGE
|
|---|
| 8 | . . W "."
|
|---|
| 9 | . . S AGE=21 ;VOLUNTEERS WITHOUT BIRTHDAYS ARE ASSUMED TO BE > 20
|
|---|
| 10 | . . S NODE=$G(^ABS(503330,DA,0)) Q:NODE=""
|
|---|
| 11 | . . S SEX=$P(NODE,"^",7) Q:SEX=""
|
|---|
| 12 | . . S BIRTHDAY=$P(NODE,"^",8)
|
|---|
| 13 | . . I BIRTHDAY S AGE=$$AGE^ABSVU2(BIRTHDAY,$G(DT))
|
|---|
| 14 | . . I SEX="M",AGE<21 S X=SEX,X1="B" D CHANGE QUIT
|
|---|
| 15 | . . I SEX="B",AGE>20 S X=SEX,X1="M" D CHANGE QUIT
|
|---|
| 16 | . . I SEX="F",AGE<21 S X=SEX,X1="G" D CHANGE QUIT
|
|---|
| 17 | . . I SEX="G",AGE>20 S X=SEX,X1="F" D CHANGE QUIT
|
|---|
| 18 | . . QUIT
|
|---|
| 19 | . QUIT
|
|---|
| 20 | W !,$S(+CHANGE:+CHANGE,1:"NO")," CHANGE",$S(CHANGE=1:"",1:"S"),$S(+CHANGE:" MADE.",1:" REQUIRED.")
|
|---|
| 21 | W !!,"DONE" QUIT
|
|---|
| 22 | CHANGE ;change sex for one volunteer
|
|---|
| 23 | K ^ABS(503330,"AD",X,DA) S ^ABS(503330,"AD",X1,DA)="",$P(^ABS(503330,DA,0),"^",7)=X1
|
|---|
| 24 | W !,$P(NODE,"^",1),$S(BIRTHDAY="":"",1:" AGE: "_AGE)," CHANGED TO "_$S(X1="F":"FEMALE",X1="G":"GIRL",X1="B":"BOY",1:"MALE")
|
|---|
| 25 | S CHANGE=CHANGE+1
|
|---|
