- 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 Mar 13, 2025@20:47:51 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
