| 1 | MCPFTIC ;WISC/TJK-COMPUTER GENERATED PFT INTERPRETATION ;7/18/96  14:10
 | 
|---|
| 2 |  ;;2.3;Medicine;;09/13/1996
 | 
|---|
| 3 | V S MCCX="",MCCI=0
 | 
|---|
| 4 |  G V1:MCTLCN'<MCITL S MCCI=MCCI+1,MCCX(MCCI)="RESTRICTIVE DEFECT"
 | 
|---|
| 5 |  G F:'MCIPTL S MCCX1=MCTLCN/MCIPTL,MCCX(MCCI)=$S(MCCX1<.5:"SEVERE ",MCCX1<.66:"MODERATE ",MCCX1<.81:"MILD ",1:"")_MCCX(MCCI) G F
 | 
|---|
| 6 | V1 I MCTLCN<MCITL,MCTLCN/MCIPTL<.8 S MCCI=MCCI+1,MCCX(MCCI)="RESTRICTIVE DEFECT MAY BE PRESENT"
 | 
|---|
| 7 | F G F1:MCIFV>.69,F1:MCIFV="" S MCCI=MCCI+1,MCCX(MCCI)=$S(MCIFV<.45:"SEVERE ",MCIFV<.61:"MODERATE ",1:"MILD ")_"AIRFLOW OBSTRUCTION"
 | 
|---|
| 8 | F1 I MCIRV>.35,MCIFV>.70 S MCCI=MCCI+1,MCCX(MCCI)="OBSTRUCTIVE DEFECT MAY BE PRESENT"
 | 
|---|
| 9 |  I 'MCTLCN,MCIFA<MCIFL S MCCI=MCCI+1,MCCX(MCCI)="RESTRICTIVE DEFECT MAY BE PRESENT"
 | 
|---|
| 10 |  ;REVERSIBLE BRONCHOCONSTRUCTION CODE HERE
 | 
|---|
| 11 | L ;
 | 
|---|
| 12 | D G A:MCIDA="",A:MCIDA'<MCIDL
 | 
|---|
| 13 |  G A:'MCIDP S MCCX1=MCIDA/MCIDP,MCCI=MCCI+1
 | 
|---|
| 14 |  S MCCX(MCCI)=$S(MCCX1<.41:"SEVERE ",MCCX1<.61:"MODERATE ",MCCX1<.81:"MILD ",1:"")_"GAS EXCHANGE DEFECT"
 | 
|---|
| 15 | A G A1:MCIAO2="",A1:MCIAO2'<80
 | 
|---|
| 16 |  S MCCI=MCCI+1,MCCX(MCCI)=$S(MCIAO2<60:"SEVERE ",MCIAO2<70:"MODERATE ",1:"MILD ")_"HYPOXEMIA"
 | 
|---|
| 17 | A1 G S:MCIAO1'>25 S MCCI=MCCI+1,MCCX(MCCI)="GAS EXCHANGE DEFECT"
 | 
|---|
| 18 | S ;
 | 
|---|
| 19 | STORE G END:'$D(MCCX) W !!,"COMPUTER GENERATED INTERPRETATIONS:"
 | 
|---|
| 20 |  S MCCI=0 F  S MCCI=$O(MCCX(MCCI)) Q:MCCI=""  Q:$D(DUOUT)!$D(DTOUT)  W !,?5,MCCX(MCCI) D
 | 
|---|
| 21 |    .S DIR(0)="Y",DIR("A")="ACCEPT THIS INTERPRETATION?",DIR("B")="YES" D ^DIR S MCACPT=$S(Y:"Y",1:"N")
 | 
|---|
| 22 |    .S (J,K)=0 F  S J=$O(^MCAR(700,MCARGDA,24,J)) Q:J=""  S K1=$G(^(J,0)) I K1,$P($G(^MCAR(693.2,+K1,0)),U)=MCCX(MCCI) S $P(^MCAR(700,MCARGDA,24,J,0),U,2)=MCACPT,K=1 Q
 | 
|---|
| 23 |    .Q:K  S:'$D(^MCAR(700,MCARGDA,24,0)) ^MCAR(700,MCARGDA,24,0)="^700.033PA^"
 | 
|---|
| 24 |    .F DA=1:1 Q:'$D(^MCAR(700,MCARGDA,24,DA))
 | 
|---|
| 25 |    .S DA(1)=MCARGDA,DIE="^MCAR(700,"_MCARGDA_",24,"
 | 
|---|
| 26 |    .S DR=".01///"_MCCX(MCCI)_";1////"_MCACPT D ^DIE S $P(^MCAR(700,MCARGDA,24,0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1 K DIE,DA,DR,J,K Q
 | 
|---|
| 27 | END K MCCI,MCCFLD,MCCND,MCCSUB,MCCX,MCCX1,MCACPT,J,K,K1 Q
 | 
|---|