MDPFTP2A ; HOIFO/NCA - PFT REPORT-FLOWS ;3/17/04 08:22
;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004
FLOW G DIF:'$D(^MCAR(700,+MDR,4)),DIF:'$O(^(4,0)) S MCX=0
S HEAD1="FLOWS" D HEAD1^MDPFTP2,HEAD2^MDPFTP2,SETNODE(MDGRS," ")
I MC17'="" S MC17A=$P(MC17,U,2),SS="MACHINE: "_$S(MC17A="F":"FLOW TURBINE",MC17A="P":"PNEUMOTACH",MC17A="A":"ANEMOMETER",MC17A="DS":"DRY WATER SEAL",MC17A="WS":"WATER SEAL",MC17A="W":"WEDGE",1:"") K MC17A D SETNODE(MDGRS,SS) S SS=""
FLOW1 S MCX=$O(^MCAR(700,MDR,4,MCX)) G DIF:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
D SETNODE(MDGRS," ")
S ND="AF",ND1=4 D PRETEST^MDPFTP2 S SS=""
S SS=" "_$S(TYPE="S":"STANDARD STUDY",TYPE="B":"AFTER BRONCHODILATOR",TYPE="I":"AFTER INHALATION CHALLENGE",1:"AFTER EXERCISE") D PREVDATE^MDPFTP2
I $P(MCREC,U,6)'="" D SETNODE(MDGRS," "_"(NOTES): "_$P(MCREC,U,6))
S ACT=$P(MCREC,U,2) I ACT S MEAS="FVC",UNITS="L",PRED=FVC X:$D(MCRC1) MCRC1 S PC=2,CI95=$S(PRED:PRED-CFVC,1:"") D PRTLINE S:TYPE="S" MCIFA=ACT,MCIFL=CI95
S ACT=$P(MCREC,U,3) I ACT S MEAS="FEV1",UNITS="L",PRED=FEV1 X:$D(MCRC1) MCRC1 S PC=3,CI95=$S(PRED:PRED-CFEV1,1:"") D PRTLINE S:TYPE="S" MCIFE=ACT
S MCDL=3,MCLNG=6,ACT=$P(MCREC,U,4) I ACT S MEAS="PF",UNITS="L/SEC",PRED=PF,PC=4,CI95=$S(PRED:PRED-CPF,1:"") D PRTLINE
S ACT=$P(MCREC,U,5) I ACT S MEAS="FEF25-75",UNITS="L/SEC",PRED=FEF2575 X:$D(MCRC4) MCRC4 S PC=5,CI95=$S(PRED:PRED-CFEF2575,1:"") D PRTLINE
S MCDL=2,MCLNG=5,ACT=$P(MCREC,U,7) I ACT S MEAS="MVV",UNITS="L/MIN",PRED=MVV X:$D(MCRC5) MCRC5 S PC=7,CI95=$S(PRED:PRED-CMVV,1:"") S:TYPE="S" MCMVVN=ACT D PRTLINE
I $P(MCREC,U,2),$P(MCREC,U,3) S SS=" FEV1/FVC %" S ACT=$P(MCREC,U,3)/$P(MCREC,U,2) S SS=SS_$J(" ",35-$L(SS))_$J(ACT*100,5,0) S:TYPE="S" MCIFV=ACT D SETNODE(MDGRS,SS) S SS=""
G FLOW1
DIF K CFVC,CFEV1,CPF,CFEF2575,CMVV G ABG:'$D(^MCAR(700,MDR,5)) S (ACT,MCIDA)=^(5) G ABG:'ACT
I '$D(HEAD1) S HEAD1="DIFFUSION" D HEAD1^MDPFTP2,HEAD2^MDPFTP2
E S HEAD1="DIFFUSION" D SETNODE(MDGRS," "),HEAD2^MDPFTP2
I MC17'="" S MC17A=$P(MC17,U,4) D SETNODE(MDGRS," METHOD: "_$S(MC17A=1:"SINGLE BREATH",MC17A=2:"STEADY STATE",1:"")) K MC17A
DIF0 S (MCIDP,PRED)=DLCOSB,UNITS="L",MEAS="DLCO-SB",PC=1
S (P1,P2)="" S RDATE1=$O(^MCAR(700,"ADI",DFN,RDATE)) I RDATE1 S P1=$O(^(RDATE1,0))
G DIF1:'P1 S MCP1=$G(^MCAR(700,P1,5))
S RDATE2=$O(^MCAR(700,"ADI",DFN,RDATE1)) I RDATE2 S P2=$O(^(RDATE2,0)) I P2 S MCP2=$G(^MCAR(700,P2,5))
DIF1 D:P1 PREVDATE^MDPFTP2 S (MCIDL,CI95)=$S(PRED:PRED-CDLCOSB,1:"") D PRTLINE
G ABG:'$D(^MCAR(700,MDR,6))
I $G(MCPV)<1 S MCPV=$$MCPV^MDPFTP1(MDR)
S MCHB=$G(^MCAR(700.1,MCPV,"HB")),MCCOHB=$G(^("COHB"))
I MCHB="",MCCOHB="" G ABG
G HB:$P(MCCOHB,U)="" S MCCOHB=$G(^MCAR(700.2,MCCOHB,0)) G HB:MCCOHB="" S COHB=""
S I=0 F S I=$O(^MCAR(700,MDR,6,I)) Q:I'?1N.N I $D(^(I,0)),$P(^(0),U,7) S COHB=$P(^(0),U,7)
G HB:COHB="" X "S MCCOHB="_$P(MCCOHB,U)
HB G ABG:$P(MCHB,U)="" S MCHB=$G(^MCAR(700.2,MCHB,0)) G ABG:MCHB=""
S HB="",I=0 F S I=$O(^MCAR(700,MDR,6,I)) Q:I'?1N.N I $D(^(I,0)),$P(^(0),U,2) S HB=$P(^(0),U,2)
G ABG:'HB X "S MCHB="_$P(MCHB,U)
;W !,"Corrected DLCO for HB: ",$J(MCHB,8,2)
; Actual Line of Code below before Mod for Washington on Over-Correction
; of the DLCO for HB & COHB
;W !,"Corr DLCO for HB & COHB:",?19,$J(MCIDL,6,2),?32,$J(MCHB,8,2),?42,$S(MCIDL'=0:$J(MCHB/MCIDL*100,8,1),1:"")
S SS="Corr DLCO for HB & COHB:"_$S(PRED:$J(PRED,6,2),1:" ")_" "_$J(MCHB,8,2)_" "_$S(MCIDL'=0:$J(MCHB/PRED*100,8,1),1:"") D SETNODE(MDGRS,SS) S SS=""
ABG K HB,COHB,MCHB,MCCOHB
K HEAD1 G SPEC:'$D(^MCAR(700,+MDR,6)),SPEC:'$D(^(6,0))
D SETNODE(MDGRS," "),SETNODE(MDGRS," ")
D SETNODE(MDGRS,"BLOOD GASES"_$E(MCDOT,1,69))
ABG0 D SETNODE(MDGRS," "),SETNODE(MDGRS," ") S SS=""
S SS="STUDY TYPE"_" pH pCO2 pO2 O2HB COHB MHB HB FiO2 A-aO2 QS/QT" D SETNODE(MDGRS,SS) S SS=""
S SS=" (NORMAL) 7.36-7.44 36-44 80-100 >88% <3% <2% <22" D SETNODE(MDGRS,SS) S SS="",MCX=0
ABG1 S MCX=$O(^MCAR(700,+MDR,6,MCX)) G SPEC:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U)
S MCTYPEP=$S(TYPE="R":"ROOM AIR",TYPE="O":"100% O2 STUDY",TYPE="X":"POST EXERCISE",TYPE="M":"MAX EXERCISE",TYPE="P":"PRE EXERCISE",1:"SUPPLEMENTAL O2 STUDY")
S HB=$P(MCREC,U,2),PH=$P(MCREC,U,3),PACO2=$P(MCREC,U,4),PAO2=$P(MCREC,U,5),O2HB=$P(MCREC,U,6),COHB=$P(MCREC,U,7),FIO2=$P(MCREC,U,8),MHB=$P(MCREC,U,9)
S (PAAO2,QSQT)=0 G ABG2:FIO2="" S PAAO2=($P(MCPFT0,U,7)-47)*FIO2-(PACO2/.8)-PAO2 S:PAAO2<0 PAAO2=0
G ABG2:PAO2="" S CAO2=(.003*650)+(1.36*HB),CAO2(1)=(.003*PAO2)+(1.36*HB*(O2HB/100)),CVO2=CAO2(1)-5
I FIO2=1 S QSQT=CAO2-CAO2(1)/(CAO2-CVO2)
ABG2 S SS=$E(MCTYPEP,1,13)_$J(" ",14-$L($E(MCTYPEP,1,13)))_$J(PH,6,3)_" "_$J(PACO2,5,1)_" "
S SS=SS_$J(PAO2,5,1)_" "_$J(O2HB,5,1)_"% "_$J(COHB,4,1)_"%"_$J(MHB,4,1)_"% "_$J(HB,5,1)_" "_$J(FIO2,5,3)_$S(PAAO2:$J(PAAO2,5,0),1:" ")_" "_$S(QSQT:$J(QSQT,6,2),1:"")
D SETNODE(MDGRS,SS) S SS=""
S:TYPE="R" MCIAO2=PAO2,MCIAO1=PAAO2
D SETNODE(MDGRS,"PATIENT TEMPERATURE (C): "_$P(MCREC,U,11))
D:$P(MCREC,U,10)'="" SETNODE(MDGRS,"(NOTES): "_$P(MCREC,U,10)) G ABG1
SPEC K HB,PH,PACO2,PAO2,O2HB,COHB,FIO2,MHB,PAAO2,QSQT,CAO2,CVO2
S CI95="" G INT:'$D(^MCAR(700,MDR,"S")),INT:'$O(^("S",0)) S MCX=0
D SETNODE(MDGRS," "),SETNODE(MDGRS," ")
S CI95="",HEAD1="SPECIAL STUDIES",MCSP="" D HEAD1^MDPFTP2,HEAD2^MDPFTP2
SPEC1 S MCX=$O(^MCAR(700,MDR,"S",MCX)) G INT:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U),(MCREC1,MCREC2)="" S:$D(^(1)) MCREC1=^(1) S:$D(^(2)) MCREC2=^(2)
S ND="AS",ND1="S" D PRETEST^MDPFTP2
D SETNODE(MDGRS," ") S SS=" "_$S(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES") D PREVDATE^MDPFTP2
I MCREC2'="",$P(MCREC2,U,8)'="" D SETNODE(MDGRS," (NOTES): "_$P(MCREC2,U,8))
I TYPE="P" S ND=MCREC2,PC=7,MEAS="PiMAX",UNITS="cmH2O",MCP1=MCP1S2,MCP2=MCP2S2 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2 Q:$D(MCOUT) G SPEC1
G:TYPE="E" ^MDPFTP3 S ND=MCREC G:TYPE="S" SMAIR
S MEAS="Raw",UNITS="cmH20/L/S",PC=2,MCP1=MCP1S0,MCP2=MCP2S0 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
S MEAS="SGaw",UNITS="L/S/cmH20",PC=3 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
S MEAS="Cst",UNITS="4cmH20",PC=4 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
G SPEC1
SMAIR S MEAS="Cdyn",UNITS="L/cmH20",PC=5 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
S MEAS="FEF50 He-Air",UNITS="L/Sec",PC=6,MCP1=MCP1S0,MCP2=MCP2S0 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
S MEAS="VISOV",UNITS="L",PC=7 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
S MEAS="CV",PC=8 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
S MEAS="CC",PC=9 S PRED="",ACT=$P(ND,U,PC) D:ACT'="" PRTLINE^MDPFTP2
S CV=$P(MCREC,U,8),(CVVC,CVTL)=""
I CV'="" S:MCVCN'="" CVVC=CV/MCVCN S:MCTLCN'="" CVTL=CV/MCTLCN
S SS=" CV/VC"
S PRED="",ACT=$P(ND,U,PC) I ACT'="" N MDSKIP S MDSKIP=1 D SETNODE(MDGRS,SS),PRTLINE^MDPFTP2
S SS=SS_$S(ACT'="":"",1:$J(" ",18-$L(SS)))_"%",SS=SS_$S(ACT'="":" ",1:$J(" ",25-$L(SS)))_$S(PRED:$J(PRED,5,2),1:"")
S SS=SS_$S(ACT'="":" ",1:$J(" ",35-$L(SS)))_$J(CVVC,5,2),SS=SS_$S(ACT'="":" ",1:$J(" ",45-$L(SS)))_$S(PRED:$J(CVVC/PRED*100,5,1),1:"") D SETNODE(MDGRS,SS) S SS=""
D SETNODE(MDGRS," CV/TLC % "_$J(CVTL,5,2))
S VISOV=$P(MCREC,U,7)
I VISOV'="",+CV'=0 D SETNODE(MDGRS," VISOV/CV %"_$J(" ",16)_$J(VISOV/CV,5,2))
K CV,CVTL,CVVC,VISOV G SPEC1
INT K MCSP G INT^MDPFTP3
EXIT Q
PRTLINE S MCP1=$G(MCP1),MCP2=$G(MCP2),SS=""
S SS=" "_MEAS,SS=SS_$J(" ",15-$L(SS))_UNITS,SS=SS_$J(" ",25-$L(SS))_$S(PRED:$J(PRED,MCLNG,MCDL),1:""),SS=SS_$J(" ",35-$L(SS))_$J(ACT,MCLNG,MCDL)
S SS=SS_$J(" ",45-$L(SS))_$S(PRED:$J(ACT/PRED*100,5,1),1:"")
S:$P(MCP1,U,PC) SS=SS_$J(" ",55-$L(SS))_$J($P(MCP1,U,PC),MCLNG,MCDL)
S:$P(MCP2,U,PC) SS=SS_$J(" ",65-$L(SS))_$J($P(MCP2,U,PC),MCLNG,MCDL)
S:(CI95)&(CI95'=PRED) SS=SS_$J(" ",72-$L(SS))_$J(CI95,6,2)
Q:+$G(MDSKIP)
D SETNODE(MDGRS,SS) S SS=""
Q
SETNODE(NODE,VALUE) ;Set the node with the string
S MDLNE=MDLNE+1,@NODE@(MDLNE,0)=VALUE
Q
MCFF1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPFTP2A 8041 printed Apr 09, 2024@20:49:27 Page 2
MDPFTP2A ; HOIFO/NCA - PFT REPORT-FLOWS ;3/17/04 08:22
+1 ;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004
FLOW if '$DATA(^MCAR(700,+MDR,4))
GOTO DIF
if '$ORDER(^(4,0))
GOTO DIF
SET MCX=0
+1 SET HEAD1="FLOWS"
DO HEAD1^MDPFTP2
DO HEAD2^MDPFTP2
DO SETNODE(MDGRS," ")
+2 IF MC17'=""
SET MC17A=$PIECE(MC17,U,2)
SET SS="MACHINE: "_$SELECT(MC17A="F":"FLOW TURBINE",MC17A="P":"PNEUMOTACH",MC17A="A":"ANEMOMETER",MC17A="DS":"DRY WATER SEAL",MC17A="WS":"WATER SEAL",MC17A="W":"WEDGE",1:"")
KILL MC17A
DO SETNODE(MDGRS,SS)
SET SS=""
FLOW1 SET MCX=$ORDER(^MCAR(700,MDR,4,MCX))
if MCX'?1N.N
GOTO DIF
SET MCREC=^(MCX,0)
SET TYPE=$PIECE(MCREC,U)
+1 DO SETNODE(MDGRS," ")
+2 SET ND="AF"
SET ND1=4
DO PRETEST^MDPFTP2
SET SS=""
+3 SET SS=" "_$SELECT(TYPE="S":"STANDARD STUDY",TYPE="B":"AFTER BRONCHODILATOR",TYPE="I":"AFTER INHALATION CHALLENGE",1:"AFTER EXERCISE")
DO PREVDATE^MDPFTP2
+4 IF $PIECE(MCREC,U,6)'=""
DO SETNODE(MDGRS," "_"(NOTES): "_$PIECE(MCREC,U,6))
+5 SET ACT=$PIECE(MCREC,U,2)
IF ACT
SET MEAS="FVC"
SET UNITS="L"
SET PRED=FVC
if $DATA(MCRC1)
XECUTE MCRC1
SET PC=2
SET CI95=$SELECT(PRED:PRED-CFVC,1:"")
DO PRTLINE
if TYPE="S"
SET MCIFA=ACT
SET MCIFL=CI95
+6 SET ACT=$PIECE(MCREC,U,3)
IF ACT
SET MEAS="FEV1"
SET UNITS="L"
SET PRED=FEV1
if $DATA(MCRC1)
XECUTE MCRC1
SET PC=3
SET CI95=$SELECT(PRED:PRED-CFEV1,1:"")
DO PRTLINE
if TYPE="S"
SET MCIFE=ACT
+7 SET MCDL=3
SET MCLNG=6
SET ACT=$PIECE(MCREC,U,4)
IF ACT
SET MEAS="PF"
SET UNITS="L/SEC"
SET PRED=PF
SET PC=4
SET CI95=$SELECT(PRED:PRED-CPF,1:"")
DO PRTLINE
+8 SET ACT=$PIECE(MCREC,U,5)
IF ACT
SET MEAS="FEF25-75"
SET UNITS="L/SEC"
SET PRED=FEF2575
if $DATA(MCRC4)
XECUTE MCRC4
SET PC=5
SET CI95=$SELECT(PRED:PRED-CFEF2575,1:"")
DO PRTLINE
+9 SET MCDL=2
SET MCLNG=5
SET ACT=$PIECE(MCREC,U,7)
IF ACT
SET MEAS="MVV"
SET UNITS="L/MIN"
SET PRED=MVV
if $DATA(MCRC5)
XECUTE MCRC5
SET PC=7
SET CI95=$SELECT(PRED:PRED-CMVV,1:"")
if TYPE="S"
SET MCMVVN=ACT
DO PRTLINE
+10 IF $PIECE(MCREC,U,2)
IF $PIECE(MCREC,U,3)
SET SS=" FEV1/FVC %"
SET ACT=$PIECE(MCREC,U,3)/$PIECE(MCREC,U,2)
SET SS=SS_$JUSTIFY(" ",35-$LENGTH(SS))_$JUSTIFY(ACT*100,5,0)
if TYPE="S"
SET MCIFV=ACT
DO SETNODE(MDGRS,SS)
SET SS=""
+11 GOTO FLOW1
DIF KILL CFVC,CFEV1,CPF,CFEF2575,CMVV
if '$DATA(^MCAR(700,MDR,5))
GOTO ABG
SET (ACT,MCIDA)=^(5)
if 'ACT
GOTO ABG
+1 IF '$DATA(HEAD1)
SET HEAD1="DIFFUSION"
DO HEAD1^MDPFTP2
DO HEAD2^MDPFTP2
+2 IF '$TEST
SET HEAD1="DIFFUSION"
DO SETNODE(MDGRS," ")
DO HEAD2^MDPFTP2
+3 IF MC17'=""
SET MC17A=$PIECE(MC17,U,4)
DO SETNODE(MDGRS," METHOD: "_$SELECT(MC17A=1:"SINGLE BREATH",MC17A=2:"STEADY STATE",1:""))
KILL MC17A
DIF0 SET (MCIDP,PRED)=DLCOSB
SET UNITS="L"
SET MEAS="DLCO-SB"
SET PC=1
+1 SET (P1,P2)=""
SET RDATE1=$ORDER(^MCAR(700,"ADI",DFN,RDATE))
IF RDATE1
SET P1=$ORDER(^(RDATE1,0))
+2 if 'P1
GOTO DIF1
SET MCP1=$GET(^MCAR(700,P1,5))
+3 SET RDATE2=$ORDER(^MCAR(700,"ADI",DFN,RDATE1))
IF RDATE2
SET P2=$ORDER(^(RDATE2,0))
IF P2
SET MCP2=$GET(^MCAR(700,P2,5))
DIF1 if P1
DO PREVDATE^MDPFTP2
SET (MCIDL,CI95)=$SELECT(PRED:PRED-CDLCOSB,1:"")
DO PRTLINE
+1 if '$DATA(^MCAR(700,MDR,6))
GOTO ABG
+2 IF $GET(MCPV)<1
SET MCPV=$$MCPV^MDPFTP1(MDR)
+3 SET MCHB=$GET(^MCAR(700.1,MCPV,"HB"))
SET MCCOHB=$GET(^("COHB"))
+4 IF MCHB=""
IF MCCOHB=""
GOTO ABG
+5 if $PIECE(MCCOHB,U)=""
GOTO HB
SET MCCOHB=$GET(^MCAR(700.2,MCCOHB,0))
if MCCOHB=""
GOTO HB
SET COHB=""
+6 SET I=0
FOR
SET I=$ORDER(^MCAR(700,MDR,6,I))
if I'?1N.N
QUIT
IF $DATA(^(I,0))
IF $PIECE(^(0),U,7)
SET COHB=$PIECE(^(0),U,7)
+7 if COHB=""
GOTO HB
XECUTE "S MCCOHB="_$PIECE(MCCOHB,U)
HB if $PIECE(MCHB,U)=""
GOTO ABG
SET MCHB=$GET(^MCAR(700.2,MCHB,0))
if MCHB=""
GOTO ABG
+1 SET HB=""
SET I=0
FOR
SET I=$ORDER(^MCAR(700,MDR,6,I))
if I'?1N.N
QUIT
IF $DATA(^(I,0))
IF $PIECE(^(0),U,2)
SET HB=$PIECE(^(0),U,2)
+2 if 'HB
GOTO ABG
XECUTE "S MCHB="_$PIECE(MCHB,U)
+3 ;W !,"Corrected DLCO for HB: ",$J(MCHB,8,2)
+4 ; Actual Line of Code below before Mod for Washington on Over-Correction
+5 ; of the DLCO for HB & COHB
+6 ;W !,"Corr DLCO for HB & COHB:",?19,$J(MCIDL,6,2),?32,$J(MCHB,8,2),?42,$S(MCIDL'=0:$J(MCHB/MCIDL*100,8,1),1:"")
+7 SET SS="Corr DLCO for HB & COHB:"_$SELECT(PRED:$JUSTIFY(PRED,6,2),1:" ")_" "_$JUSTIFY(MCHB,8,2)_" "_$SELECT(MCIDL'=0:$JUSTIFY(MCHB/PRED*100,8,1),1:"")
DO SETNODE(MDGRS,SS)
SET SS=""
ABG KILL HB,COHB,MCHB,MCCOHB
+1 KILL HEAD1
if '$DATA(^MCAR(700,+MDR,6))
GOTO SPEC
if '$DATA(^(6,0))
GOTO SPEC
+2 DO SETNODE(MDGRS," ")
DO SETNODE(MDGRS," ")
+3 DO SETNODE(MDGRS,"BLOOD GASES"_$EXTRACT(MCDOT,1,69))
ABG0 DO SETNODE(MDGRS," ")
DO SETNODE(MDGRS," ")
SET SS=""
+1 SET SS="STUDY TYPE"_" pH pCO2 pO2 O2HB COHB MHB HB FiO2 A-aO2 QS/QT"
DO SETNODE(MDGRS,SS)
SET SS=""
+2 SET SS=" (NORMAL) 7.36-7.44 36-44 80-100 >88% <3% <2% <22"
DO SETNODE(MDGRS,SS)
SET SS=""
SET MCX=0
ABG1 SET MCX=$ORDER(^MCAR(700,+MDR,6,MCX))
if MCX'?1N.N
GOTO SPEC
SET MCREC=^(MCX,0)
SET TYPE=$PIECE(MCREC,U)
+1 SET MCTYPEP=$SELECT(TYPE="R":"ROOM AIR",TYPE="O":"100% O2 STUDY",TYPE="X":"POST EXERCISE",TYPE="M":"MAX EXERCISE",TYPE="P":"PRE EXERCISE",1:"SUPPLEMENTAL O2 STUDY")
+2 SET HB=$PIECE(MCREC,U,2)
SET PH=$PIECE(MCREC,U,3)
SET PACO2=$PIECE(MCREC,U,4)
SET PAO2=$PIECE(MCREC,U,5)
SET O2HB=$PIECE(MCREC,U,6)
SET COHB=$PIECE(MCREC,U,7)
SET FIO2=$PIECE(MCREC,U,8)
SET MHB=$PIECE(MCREC,U,9)
+3 SET (PAAO2,QSQT)=0
if FIO2=""
GOTO ABG2
SET PAAO2=($PIECE(MCPFT0,U,7)-47)*FIO2-(PACO2/.8)-PAO2
if PAAO2<0
SET PAAO2=0
+4 if PAO2=""
GOTO ABG2
SET CAO2=(.003*650)+(1.36*HB)
SET CAO2(1)=(.003*PAO2)+(1.36*HB*(O2HB/100))
SET CVO2=CAO2(1)-5
+5 IF FIO2=1
SET QSQT=CAO2-CAO2(1)/(CAO2-CVO2)
ABG2 SET SS=$EXTRACT(MCTYPEP,1,13)_$JUSTIFY(" ",14-$LENGTH($EXTRACT(MCTYPEP,1,13)))_$JUSTIFY(PH,6,3)_" "_$JUSTIFY(PACO2,5,1)_" "
+1 SET SS=SS_$JUSTIFY(PAO2,5,1)_" "_$JUSTIFY(O2HB,5,1)_"% "_$JUSTIFY(COHB,4,1)_"%"_$JUSTIFY(MHB,4,1)_"% "_$JUSTIFY(HB,5,1)_" "_$JUSTIFY(FIO2,5,3)_$SELECT(PAAO2:$JUSTIFY(PAAO2,5,0),1:" ")_" "_$SELECT(QSQT:$JUSTIFY(QSQT,6,2),1:"")
+2 DO SETNODE(MDGRS,SS)
SET SS=""
+3 if TYPE="R"
SET MCIAO2=PAO2
SET MCIAO1=PAAO2
+4 DO SETNODE(MDGRS,"PATIENT TEMPERATURE (C): "_$PIECE(MCREC,U,11))
+5 if $PIECE(MCREC,U,10)'=""
DO SETNODE(MDGRS,"(NOTES): "_$PIECE(MCREC,U,10))
GOTO ABG1
SPEC KILL HB,PH,PACO2,PAO2,O2HB,COHB,FIO2,MHB,PAAO2,QSQT,CAO2,CVO2
+1 SET CI95=""
if '$DATA(^MCAR(700,MDR,"S"))
GOTO INT
if '$ORDER(^("S",0))
GOTO INT
SET MCX=0
+2 DO SETNODE(MDGRS," ")
DO SETNODE(MDGRS," ")
+3 SET CI95=""
SET HEAD1="SPECIAL STUDIES"
SET MCSP=""
DO HEAD1^MDPFTP2
DO HEAD2^MDPFTP2
SPEC1 SET MCX=$ORDER(^MCAR(700,MDR,"S",MCX))
if MCX'?1N.N
GOTO INT
SET MCREC=^(MCX,0)
SET TYPE=$PIECE(MCREC,U)
SET (MCREC1,MCREC2)=""
if $DATA(^(1))
SET MCREC1=^(1)
if $DATA(^(2))
SET MCREC2=^(2)
+1 SET ND="AS"
SET ND1="S"
DO PRETEST^MDPFTP2
+2 DO SETNODE(MDGRS," ")
SET SS=" "_$SELECT(TYPE="E":"EXERCISE",TYPE="M":"MECHANICS",TYPE="S":"SMALL AIRWAY",1:"MAXIMUM PRESSURES")
DO PREVDATE^MDPFTP2
+3 IF MCREC2'=""
IF $PIECE(MCREC2,U,8)'=""
DO SETNODE(MDGRS," (NOTES): "_$PIECE(MCREC2,U,8))
+4 IF TYPE="P"
SET ND=MCREC2
SET PC=7
SET MEAS="PiMAX"
SET UNITS="cmH2O"
SET MCP1=MCP1S2
SET MCP2=MCP2S2
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
if $DATA(MCOUT)
QUIT
GOTO SPEC1
+5 if TYPE="E"
GOTO ^MDPFTP3
SET ND=MCREC
if TYPE="S"
GOTO SMAIR
+6 SET MEAS="Raw"
SET UNITS="cmH20/L/S"
SET PC=2
SET MCP1=MCP1S0
SET MCP2=MCP2S0
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
+7 SET MEAS="SGaw"
SET UNITS="L/S/cmH20"
SET PC=3
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
+8 SET MEAS="Cst"
SET UNITS="4cmH20"
SET PC=4
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
+9 GOTO SPEC1
SMAIR SET MEAS="Cdyn"
SET UNITS="L/cmH20"
SET PC=5
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
+1 SET MEAS="FEF50 He-Air"
SET UNITS="L/Sec"
SET PC=6
SET MCP1=MCP1S0
SET MCP2=MCP2S0
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
+2 SET MEAS="VISOV"
SET UNITS="L"
SET PC=7
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
+3 SET MEAS="CV"
SET PC=8
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
+4 SET MEAS="CC"
SET PC=9
SET PRED=""
SET ACT=$PIECE(ND,U,PC)
if ACT'=""
DO PRTLINE^MDPFTP2
+5 SET CV=$PIECE(MCREC,U,8)
SET (CVVC,CVTL)=""
+6 IF CV'=""
if MCVCN'=""
SET CVVC=CV/MCVCN
if MCTLCN'=""
SET CVTL=CV/MCTLCN
+7 SET SS=" CV/VC"
+8 SET PRED=""
SET ACT=$PIECE(ND,U,PC)
IF ACT'=""
NEW MDSKIP
SET MDSKIP=1
DO SETNODE(MDGRS,SS)
DO PRTLINE^MDPFTP2
+9 SET SS=SS_$SELECT(ACT'="":"",1:$JUSTIFY(" ",18-$LENGTH(SS)))_"%"
SET SS=SS_$SELECT(ACT'="":" ",1:$JUSTIFY(" ",25-$LENGTH(SS)))_$SELECT(PRED:$JUSTIFY(PRED,5,2),1:"")
+10 SET SS=SS_$SELECT(ACT'="":" ",1:$JUSTIFY(" ",35-$LENGTH(SS)))_$JUSTIFY(CVVC,5,2)
SET SS=SS_$SELECT(ACT'="":" ",1:$JUSTIFY(" ",45-$LENGTH(SS)))_$SELECT(PRED:$JUSTIFY(CVVC/PRED*100,5,1),1:"")
DO SETNODE(MDGRS,SS)
SET SS=""
+11 DO SETNODE(MDGRS," CV/TLC % "_$JUSTIFY(CVTL,5,2))
+12 SET VISOV=$PIECE(MCREC,U,7)
+13 IF VISOV'=""
IF +CV'=0
DO SETNODE(MDGRS," VISOV/CV %"_$JUSTIFY(" ",16)_$JUSTIFY(VISOV/CV,5,2))
+14 KILL CV,CVTL,CVVC,VISOV
GOTO SPEC1
INT KILL MCSP
GOTO INT^MDPFTP3
EXIT QUIT
PRTLINE SET MCP1=$GET(MCP1)
SET MCP2=$GET(MCP2)
SET SS=""
+1 SET SS=" "_MEAS
SET SS=SS_$JUSTIFY(" ",15-$LENGTH(SS))_UNITS
SET SS=SS_$JUSTIFY(" ",25-$LENGTH(SS))_$SELECT(PRED:$JUSTIFY(PRED,MCLNG,MCDL),1:"")
SET SS=SS_$JUSTIFY(" ",35-$LENGTH(SS))_$JUSTIFY(ACT,MCLNG,MCDL)
+2 SET SS=SS_$JUSTIFY(" ",45-$LENGTH(SS))_$SELECT(PRED:$JUSTIFY(ACT/PRED*100,5,1),1:"")
+3 if $PIECE(MCP1,U,PC)
SET SS=SS_$JUSTIFY(" ",55-$LENGTH(SS))_$JUSTIFY($PIECE(MCP1,U,PC),MCLNG,MCDL)
+4 if $PIECE(MCP2,U,PC)
SET SS=SS_$JUSTIFY(" ",65-$LENGTH(SS))_$JUSTIFY($PIECE(MCP2,U,PC),MCLNG,MCDL)
+5 if (CI95)&(CI95'=PRED)
SET SS=SS_$JUSTIFY(" ",72-$LENGTH(SS))_$JUSTIFY(CI95,6,2)
+6 if +$GET(MDSKIP)
QUIT
+7 DO SETNODE(MDGRS,SS)
SET SS=""
+8 QUIT
SETNODE(NODE,VALUE) ;Set the node with the string
+1 SET MDLNE=MDLNE+1
SET @NODE@(MDLNE,0)=VALUE
+2 QUIT
MCFF1 QUIT
