MCPFTSS.m

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

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