Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCPFTSS

MCPFTSS.m

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