MCBPFTP4 ;WISC/TJK,ALG-PFT BRIEF REPORT-ABGS ;5/15/92 15:32
;;2.3;Medicine;;09/13/1996
ABG K HEAD1 G SPEC:'$D(^MCAR(700,MCARGDA,6)),SPEC:'$D(^(6,0))
W !! X MCFF Q:$D(MCOUT) W "BLOOD GASES",$E(MCDOT,1,69) X MCFF Q:$D(MCOUT)
ABG0 W !! X MCFF Q:$D(MCOUT) W "STUDY TYPE",?20,"pH ",?40,"pCO2",?60,"pO2" X MCFF
Q:$D(MCOUT) W !,?3,"(NORMAL)",?16,"7.36-7.44",?40,"36-44",?60,"80-100",! X MCFF Q:$D(MCOUT) S MCX=0
ABG1 S MCX=$O(^MCAR(700,MCARGDA,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",1:"SUPPLEMENTAL O2 STUDY")
S PH=$P(MCREC,U,3),PACO2=$P(MCREC,U,4),PAO2=$P(MCREC,U,5),FIO2=$P(MCREC,U,8)
S (PAAO2,QSQT)=0 G ABG2:FIO2="" S PAAO2=($P(MCPFT0,U,7)-47)*FIO2-(PACO2/.8)-PAO2 S:PAAO2<0 PAAO2=0
ABG2 W !,$E(MCTYPEP,1,13),?17,$J(PH,6,3),?38,$J(PACO2,5,1),?58,$J(PAO2,5,1)
S:TYPE="R" MCIAO2=PAO2
X MCFF Q:$D(MCOUT) W:$P(MCREC,U,10)'="" !,"(NOTES): ",$P(MCREC,U,10) X MCFF Q:$D(MCOUT) G ABG1
SPEC K HB,PH,PACO2,PAO2,O2HB,COHB,FIO2,MHB,PAAO2,QSQT,CAO2,CVO2
G ^MCBPFTP7
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCBPFTP4 1083 printed Oct 16, 2024@18:15:21 Page 2
MCBPFTP4 ;WISC/TJK,ALG-PFT BRIEF REPORT-ABGS ;5/15/92 15:32
+1 ;;2.3;Medicine;;09/13/1996
ABG KILL HEAD1
if '$DATA(^MCAR(700,MCARGDA,6))
GOTO SPEC
if '$DATA(^(6,0))
GOTO SPEC
+1 WRITE !!
XECUTE MCFF
if $DATA(MCOUT)
QUIT
WRITE "BLOOD GASES",$EXTRACT(MCDOT,1,69)
XECUTE MCFF
if $DATA(MCOUT)
QUIT
ABG0 WRITE !!
XECUTE MCFF
if $DATA(MCOUT)
QUIT
WRITE "STUDY TYPE",?20,"pH ",?40,"pCO2",?60,"pO2"
XECUTE MCFF
+1 if $DATA(MCOUT)
QUIT
WRITE !,?3,"(NORMAL)",?16,"7.36-7.44",?40,"36-44",?60,"80-100",!
XECUTE MCFF
if $DATA(MCOUT)
QUIT
SET MCX=0
ABG1 SET MCX=$ORDER(^MCAR(700,MCARGDA,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",1:"SUPPLEMENTAL O2 STUDY")
+2 SET PH=$PIECE(MCREC,U,3)
SET PACO2=$PIECE(MCREC,U,4)
SET PAO2=$PIECE(MCREC,U,5)
SET FIO2=$PIECE(MCREC,U,8)
+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
ABG2 WRITE !,$EXTRACT(MCTYPEP,1,13),?17,$JUSTIFY(PH,6,3),?38,$JUSTIFY(PACO2,5,1),?58,$JUSTIFY(PAO2,5,1)
+1 if TYPE="R"
SET MCIAO2=PAO2
+2 XECUTE MCFF
if $DATA(MCOUT)
QUIT
if $PIECE(MCREC,U,10)'=""
WRITE !,"(NOTES): ",$PIECE(MCREC,U,10)
XECUTE MCFF
if $DATA(MCOUT)
QUIT
GOTO ABG1
SPEC KILL HB,PH,PACO2,PAO2,O2HB,COHB,FIO2,MHB,PAAO2,QSQT,CAO2,CVO2
+1 GOTO ^MCBPFTP7
