| 1 | MCPFTSS ;WISC/MLH-PFT SPECIAL STUDIES ANCILLARY ;7/9/99 10:13
|
|---|
| 2 | ;;2.3;Medicine;**25,35**;09/13/1996
|
|---|
| 3 | ; Reference IA # 10061 for VADPT call.
|
|---|
| 4 | IF $G(DJR)=2452 D
|
|---|
| 5 | . I V(23)="MECHANICS" S $P(DJJ(23),U,6)="MCPFT061"
|
|---|
| 6 | . I V(23)="SMALL AIRWAY" S $P(DJJ(23),U,6)="MCPFT062"
|
|---|
| 7 | . I V(23)="EXERCISE" S $P(DJJ(23),U,6)="MCPFT063"
|
|---|
| 8 | . I V(23)="MAXIMUM PRESSURES" S $P(DJJ(23),U,6)="MCPFT064"
|
|---|
| 9 | . Q
|
|---|
| 10 | ;END IF
|
|---|
| 11 | ;
|
|---|
| 12 | Q
|
|---|
| 13 | RACECDE(DFN) ;Returns a value of RACE B = BLACK, O = ASIAN, and null for anything else
|
|---|
| 14 | D DEM^VADPT S MCRACE=$P(VADM(8),U,2)
|
|---|
| 15 | N MCMRACE,MCHOLD S MCHOLD=MCRACE,MCRACE=$$ETHN^MCPFTP1(MCHOLD,.VADM)
|
|---|
| 16 | D KVAR^VADPT S MCMRACE=""
|
|---|
| 17 | I MCRACE="" D RACEMSG
|
|---|
| 18 | I MCRACE'="" D
|
|---|
| 19 | .S:MCRACE["ASIAN" MCMRACE=MCMRACE_"O"
|
|---|
| 20 | .S:MCRACE["BLACK" MCMRACE=MCMRACE_"B"
|
|---|
| 21 | S MCRACE=$S(MCMRACE'="":MCMRACE,1:"")
|
|---|
| 22 | Q MCRACE
|
|---|
| 23 | ;
|
|---|
| 24 | RACEMSG ; If patient race field is empty, notify user
|
|---|
| 25 | W $C(7),!!?5,"*** Patient's race not specified in the patient file ***"
|
|---|
| 26 | H 1 W $C(7) N X R X:3 W !
|
|---|
| 27 | Q
|
|---|
