- MCPFTIC ;WISC/TJK-COMPUTER GENERATED PFT INTERPRETATION ;7/18/96 14:10
- ;;2.3;Medicine;;09/13/1996
- V S MCCX="",MCCI=0
- G V1:MCTLCN'<MCITL S MCCI=MCCI+1,MCCX(MCCI)="RESTRICTIVE DEFECT"
- G F:'MCIPTL S MCCX1=MCTLCN/MCIPTL,MCCX(MCCI)=$S(MCCX1<.5:"SEVERE ",MCCX1<.66:"MODERATE ",MCCX1<.81:"MILD ",1:"")_MCCX(MCCI) G F
- V1 I MCTLCN<MCITL,MCTLCN/MCIPTL<.8 S MCCI=MCCI+1,MCCX(MCCI)="RESTRICTIVE DEFECT MAY BE PRESENT"
- F G F1:MCIFV>.69,F1:MCIFV="" S MCCI=MCCI+1,MCCX(MCCI)=$S(MCIFV<.45:"SEVERE ",MCIFV<.61:"MODERATE ",1:"MILD ")_"AIRFLOW OBSTRUCTION"
- F1 I MCIRV>.35,MCIFV>.70 S MCCI=MCCI+1,MCCX(MCCI)="OBSTRUCTIVE DEFECT MAY BE PRESENT"
- I 'MCTLCN,MCIFA<MCIFL S MCCI=MCCI+1,MCCX(MCCI)="RESTRICTIVE DEFECT MAY BE PRESENT"
- ;REVERSIBLE BRONCHOCONSTRUCTION CODE HERE
- L ;
- D G A:MCIDA="",A:MCIDA'<MCIDL
- G A:'MCIDP S MCCX1=MCIDA/MCIDP,MCCI=MCCI+1
- S MCCX(MCCI)=$S(MCCX1<.41:"SEVERE ",MCCX1<.61:"MODERATE ",MCCX1<.81:"MILD ",1:"")_"GAS EXCHANGE DEFECT"
- A G A1:MCIAO2="",A1:MCIAO2'<80
- S MCCI=MCCI+1,MCCX(MCCI)=$S(MCIAO2<60:"SEVERE ",MCIAO2<70:"MODERATE ",1:"MILD ")_"HYPOXEMIA"
- A1 G S:MCIAO1'>25 S MCCI=MCCI+1,MCCX(MCCI)="GAS EXCHANGE DEFECT"
- S ;
- STORE G END:'$D(MCCX) W !!,"COMPUTER GENERATED INTERPRETATIONS:"
- S MCCI=0 F S MCCI=$O(MCCX(MCCI)) Q:MCCI="" Q:$D(DUOUT)!$D(DTOUT) W !,?5,MCCX(MCCI) D
- .S DIR(0)="Y",DIR("A")="ACCEPT THIS INTERPRETATION?",DIR("B")="YES" D ^DIR S MCACPT=$S(Y:"Y",1:"N")
- .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
- .Q:K S:'$D(^MCAR(700,MCARGDA,24,0)) ^MCAR(700,MCARGDA,24,0)="^700.033PA^"
- .F DA=1:1 Q:'$D(^MCAR(700,MCARGDA,24,DA))
- .S DA(1)=MCARGDA,DIE="^MCAR(700,"_MCARGDA_",24,"
- .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
- END K MCCI,MCCFLD,MCCND,MCCSUB,MCCX,MCCX1,MCACPT,J,K,K1 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPFTIC 1951 printed Feb 18, 2025@23:42:28 Page 2
- MCPFTIC ;WISC/TJK-COMPUTER GENERATED PFT INTERPRETATION ;7/18/96 14:10
- +1 ;;2.3;Medicine;;09/13/1996
- V SET MCCX=""
- SET MCCI=0
- +1 if MCTLCN'<MCITL
- GOTO V1
- SET MCCI=MCCI+1
- SET MCCX(MCCI)="RESTRICTIVE DEFECT"
- +2 if 'MCIPTL
- GOTO F
- SET MCCX1=MCTLCN/MCIPTL
- SET MCCX(MCCI)=$SELECT(MCCX1<.5:"SEVERE ",MCCX1<.66:"MODERATE ",MCCX1<.81:"MILD ",1:"")_MCCX(MCCI)
- GOTO F
- V1 IF MCTLCN<MCITL
- IF MCTLCN/MCIPTL<.8
- SET MCCI=MCCI+1
- SET MCCX(MCCI)="RESTRICTIVE DEFECT MAY BE PRESENT"
- F if MCIFV>.69
- GOTO F1
- if MCIFV=""
- GOTO F1
- SET MCCI=MCCI+1
- SET MCCX(MCCI)=$SELECT(MCIFV<.45:"SEVERE ",MCIFV<.61:"MODERATE ",1:"MILD ")_"AIRFLOW OBSTRUCTION"
- F1 IF MCIRV>.35
- IF MCIFV>.70
- SET MCCI=MCCI+1
- SET MCCX(MCCI)="OBSTRUCTIVE DEFECT MAY BE PRESENT"
- +1 IF 'MCTLCN
- IF MCIFA<MCIFL
- SET MCCI=MCCI+1
- SET MCCX(MCCI)="RESTRICTIVE DEFECT MAY BE PRESENT"
- +2 ;REVERSIBLE BRONCHOCONSTRUCTION CODE HERE
- L ;
- D if MCIDA=""
- GOTO A
- if MCIDA'<MCIDL
- GOTO A
- +1 if 'MCIDP
- GOTO A
- SET MCCX1=MCIDA/MCIDP
- SET MCCI=MCCI+1
- +2 SET MCCX(MCCI)=$SELECT(MCCX1<.41:"SEVERE ",MCCX1<.61:"MODERATE ",MCCX1<.81:"MILD ",1:"")_"GAS EXCHANGE DEFECT"
- A if MCIAO2=""
- GOTO A1
- if MCIAO2'<80
- GOTO A1
- +1 SET MCCI=MCCI+1
- SET MCCX(MCCI)=$SELECT(MCIAO2<60:"SEVERE ",MCIAO2<70:"MODERATE ",1:"MILD ")_"HYPOXEMIA"
- A1 if MCIAO1'>25
- GOTO S
- SET MCCI=MCCI+1
- SET MCCX(MCCI)="GAS EXCHANGE DEFECT"
- S ;
- STORE if '$DATA(MCCX)
- GOTO END
- WRITE !!,"COMPUTER GENERATED INTERPRETATIONS:"
- +1 SET MCCI=0
- FOR
- SET MCCI=$ORDER(MCCX(MCCI))
- if MCCI=""
- QUIT
- if $DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- WRITE !,?5,MCCX(MCCI)
- Begin DoDot:1
- +2 SET DIR(0)="Y"
- SET DIR("A")="ACCEPT THIS INTERPRETATION?"
- SET DIR("B")="YES"
- DO ^DIR
- SET MCACPT=$SELECT(Y:"Y",1:"N")
- +3 SET (J,K)=0
- FOR
- SET J=$ORDER(^MCAR(700,MCARGDA,24,J))
- if J=""
- QUIT
- SET K1=$GET(^(J,0))
- IF K1
- IF $PIECE($GET(^MCAR(693.2,+K1,0)),U)=MCCX(MCCI)
- SET $PIECE(^MCAR(700,MCARGDA,24,J,0),U,2)=MCACPT
- SET K=1
- QUIT
- +4 if K
- QUIT
- if '$DATA(^MCAR(700,MCARGDA,24,0))
- SET ^MCAR(700,MCARGDA,24,0)="^700.033PA^"
- +5 FOR DA=1:1
- if '$DATA(^MCAR(700,MCARGDA,24,DA))
- QUIT
- +6 SET DA(1)=MCARGDA
- SET DIE="^MCAR(700,"_MCARGDA_",24,"
- +7 SET DR=".01///"_MCCX(MCCI)_";1////"_MCACPT
- DO ^DIE
- SET $PIECE(^MCAR(700,MCARGDA,24,0),U,3)=DA
- SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
- KILL DIE,DA,DR,J,K
- QUIT
- End DoDot:1
- END KILL MCCI,MCCFLD,MCCND,MCCSUB,MCCX,MCCX1,MCACPT,J,K,K1
- QUIT
