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 Apr 09, 2024@21:18:44 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
