- 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 Feb 18, 2025@23:42:38 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