MCPFTSS ;WISC/MLH-PFT SPECIAL STUDIES ANCILLARY ;7/9/99 10:13
;;2.3;Medicine;**25,35**;09/13/1996
; Reference IA # 10061 for VADPT call.
IF $G(DJR)=2452 D
. I V(23)="MECHANICS" S $P(DJJ(23),U,6)="MCPFT061"
. I V(23)="SMALL AIRWAY" S $P(DJJ(23),U,6)="MCPFT062"
. I V(23)="EXERCISE" S $P(DJJ(23),U,6)="MCPFT063"
. I V(23)="MAXIMUM PRESSURES" S $P(DJJ(23),U,6)="MCPFT064"
. Q
;END IF
;
Q
RACECDE(DFN) ;Returns a value of RACE B = BLACK, O = ASIAN, and null for anything else
D DEM^VADPT S MCRACE=$P(VADM(8),U,2)
N MCMRACE,MCHOLD S MCHOLD=MCRACE,MCRACE=$$ETHN^MCPFTP1(MCHOLD,.VADM)
D KVAR^VADPT S MCMRACE=""
I MCRACE="" D RACEMSG
I MCRACE'="" D
.S:MCRACE["ASIAN" MCMRACE=MCMRACE_"O"
.S:MCRACE["BLACK" MCMRACE=MCMRACE_"B"
S MCRACE=$S(MCMRACE'="":MCMRACE,1:"")
Q MCRACE
;
RACEMSG ; If patient race field is empty, notify user
W $C(7),!!?5,"*** Patient's race not specified in the patient file ***"
H 1 W $C(7) N X R X:3 W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPFTSS 977 printed Dec 13, 2024@02:16:11 Page 2
MCPFTSS ;WISC/MLH-PFT SPECIAL STUDIES ANCILLARY ;7/9/99 10:13
+1 ;;2.3;Medicine;**25,35**;09/13/1996
+2 ; Reference IA # 10061 for VADPT call.
+3 IF $GET(DJR)=2452
Begin DoDot:1
+4 IF V(23)="MECHANICS"
SET $PIECE(DJJ(23),U,6)="MCPFT061"
+5 IF V(23)="SMALL AIRWAY"
SET $PIECE(DJJ(23),U,6)="MCPFT062"
+6 IF V(23)="EXERCISE"
SET $PIECE(DJJ(23),U,6)="MCPFT063"
+7 IF V(23)="MAXIMUM PRESSURES"
SET $PIECE(DJJ(23),U,6)="MCPFT064"
+8 QUIT
End DoDot:1
+9 ;END IF
+10 ;
+11 QUIT
RACECDE(DFN) ;Returns a value of RACE B = BLACK, O = ASIAN, and null for anything else
+1 DO DEM^VADPT
SET MCRACE=$PIECE(VADM(8),U,2)
+2 NEW MCMRACE,MCHOLD
SET MCHOLD=MCRACE
SET MCRACE=$$ETHN^MCPFTP1(MCHOLD,.VADM)
+3 DO KVAR^VADPT
SET MCMRACE=""
+4 IF MCRACE=""
DO RACEMSG
+5 IF MCRACE'=""
Begin DoDot:1
+6 if MCRACE["ASIAN"
SET MCMRACE=MCMRACE_"O"
+7 if MCRACE["BLACK"
SET MCMRACE=MCMRACE_"B"
End DoDot:1
+8 SET MCRACE=$SELECT(MCMRACE'="":MCMRACE,1:"")
+9 QUIT MCRACE
+10 ;
RACEMSG ; If patient race field is empty, notify user
+1 WRITE $CHAR(7),!!?5,"*** Patient's race not specified in the patient file ***"
+2 HANG 1
WRITE $CHAR(7)
NEW X
READ X:3
WRITE !
+3 QUIT
