MCPFTIC.m

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

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