AZHRDEM1.m

AZHRDEM1 ; [ 04/19/90  10:50 AM ]

 D ^%AUKVAR S (AZHRMALS,AZHRFEMS,AZHRSTS,AZHRADDS)=0

 W !,"BUILDING RANDOM NAME TABLES...",!

 S AZHRMAX=$P(^DPT(0),U,3)*.1,AZHRDFN=0 

 F  S AZHRDFN=$O(^DPT(AZHRDFN)) Q:AZHRDFN'=+AZHRDFN!((AZHRMALS+AZHRFEMS)>(AZHRMAX-1))  D BILDNAM D:$D(^DPT(AZHRDFN,.11)) BILDADD

 S ^AZHRRAND("M",0)=AZHRMALS,^AZHRRAND("F",0)=AZHRFEMS,^AZHRRAND("A",0)=AZHRADDS K ^AZHRRAND("T")

 D BILDST

 K AZHRMALS,AZHRFEMS,AZHRMAX,AZHRDFN,AZHRSEX,AZHRNAME,AZHRRAND,AZHRSTS,AZHRCOM,AZHRST,AZHRADDR,AZHRADDS

 Q

BILDNAM ;

 S AZHRNAME=$P($P(^DPT(AZHRDFN,0),U,1),",",2)

 S AZHRSEX=$P(^DPT(AZHRDFN,0),U,2)

 D:AZHRSEX="M"&(AZHRMALS<(AZHRMAX/2)) MALNAM

 D:AZHRSEX="F"&(AZHRFEMS<(AZHRMAX/2)) FEMNAM

 Q

MALNAM ;

 I '$D(^AZHRRAND("T",AZHRNAME)) S AZHRMALS=AZHRMALS+1,^AZHRRAND("T",AZHRNAME)="",^AZHRRAND("M",AZHRMALS)=AZHRNAME W "M"

 Q

FEMNAM ;

 I '$D(^AZHRRAND("T",AZHRNAME)) S AZHRFEMS=AZHRFEMS+1,^AZHRRAND("T",AZHRNAME)="",^AZHRRAND("F",AZHRFEMS)=AZHRNAME W "F"

 Q

BILDADD ;

 S AZHRADDR=$P(^DPT(AZHRDFN,.11),U,1)

 I AZHRADDR'="",'$D(^AZHRRAND("T",AZHRADDR)) S AZHRADDS=AZHRADDS+1,^AZHRRAND("T",AZHRADDR)="",^AZHRRAND("A",AZHRADDS)=AZHRADDR W "A"

 Q

BILDST ;

 S AZHRST=$P(^AUTTLOC(DUZ(2),0),U,14),AZHRCOM=0

 F  S AZHRCOM=$O(^AUTTCOM(AZHRCOM)) Q:AZHRCOM'=+AZHRCOM  I $P(^AUTTCOM(AZHRCOM,0),U,3)=AZHRST S AZHRSTS=AZHRSTS+1,^AZHRRAND("S",AZHRSTS)=$P(^AUTTCOM(AZHRCOM,0),U,1) W "S"

 S ^AZHRRAND("S",0)=AZHRSTS

 Q

AZHRDEM1  ; [ 04/19/90  10:50 AM ]

 +1        DO ^%AUKVAR

           SET (AZHRMALS,AZHRFEMS,AZHRSTS,AZHRADDS)=0

 +2        WRITE !,"BUILDING RANDOM NAME TABLES...",!

 +3        SET AZHRMAX=$PIECE(^DPT(0),U,3)*.1

           SET AZHRDFN=0

 +4        FOR 

               SET AZHRDFN=$ORDER(^DPT(AZHRDFN))

               IF AZHRDFN'=+AZHRDFN!((AZHRMALS+AZHRFEMS)>(AZHRMAX-1))

                   QUIT 

               DO BILDNAM

               IF $DATA(^DPT(AZHRDFN,.11))

                   DO BILDADD

 +5        SET ^AZHRRAND("M",0)=AZHRMALS

           SET ^AZHRRAND("F",0)=AZHRFEMS

           SET ^AZHRRAND("A",0)=AZHRADDS

           KILL ^AZHRRAND("T")

 +6        DO BILDST

 +7        KILL AZHRMALS,AZHRFEMS,AZHRMAX,AZHRDFN,AZHRSEX,AZHRNAME,AZHRRAND,AZHRSTS,AZHRCOM,AZHRST,AZHRADDR,AZHRADDS

 +8        QUIT 

BILDNAM   ;

 +1        SET AZHRNAME=$PIECE($PIECE(^DPT(AZHRDFN,0),U,1),",",2)

 +2        SET AZHRSEX=$PIECE(^DPT(AZHRDFN,0),U,2)

 +3        IF AZHRSEX="M"&(AZHRMALS<(AZHRMAX/2))

               DO MALNAM

 +4        IF AZHRSEX="F"&(AZHRFEMS<(AZHRMAX/2))

               DO FEMNAM

 +5        QUIT 

MALNAM    ;

 +1        IF '$DATA(^AZHRRAND("T",AZHRNAME))

               SET AZHRMALS=AZHRMALS+1

               SET ^AZHRRAND("T",AZHRNAME)=""

               SET ^AZHRRAND("M",AZHRMALS)=AZHRNAME

               WRITE "M"

 +2        QUIT 

FEMNAM    ;

 +1        IF '$DATA(^AZHRRAND("T",AZHRNAME))

               SET AZHRFEMS=AZHRFEMS+1

               SET ^AZHRRAND("T",AZHRNAME)=""

               SET ^AZHRRAND("F",AZHRFEMS)=AZHRNAME

               WRITE "F"

 +2        QUIT 

BILDADD   ;

 +1        SET AZHRADDR=$PIECE(^DPT(AZHRDFN,.11),U,1)

 +2        IF AZHRADDR'=""

               IF '$DATA(^AZHRRAND("T",AZHRADDR))

                   SET AZHRADDS=AZHRADDS+1

                   SET ^AZHRRAND("T",AZHRADDR)=""

                   SET ^AZHRRAND("A",AZHRADDS)=AZHRADDR

                   WRITE "A"

 +3        QUIT 

BILDST    ;

 +1        SET AZHRST=$PIECE(^AUTTLOC(DUZ(2),0),U,14)

           SET AZHRCOM=0

 +2        FOR 

               SET AZHRCOM=$ORDER(^AUTTCOM(AZHRCOM))

               IF AZHRCOM'=+AZHRCOM

                   QUIT 

               IF $PIECE(^AUTTCOM(AZHRCOM,0),U,3)=AZHRST

                   SET AZHRSTS=AZHRSTS+1

                   SET ^AZHRRAND("S",AZHRSTS)=$PIECE(^AUTTCOM(AZHRCOM,0),U,1)

                   WRITE "S"

 +3        SET ^AZHRRAND("S",0)=AZHRSTS

 +4        QUIT