source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVBGMF.m@ 1211

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

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1ABSVBGMF ;VAMC ALTOONA/CTB - UPDATE SEX OF VOLUNTEER ;9/1/99 11:04 PM
2V ;;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
22CHANGE ;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
Note: See TracBrowser for help on using the repository browser.