- MCPFTP3 ;WISC/TJK-PFT REPORT-ABGS ;8/25/92 08:43
- ;;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",?17,"pH ",?23,"pCO2",?29,"pO2",?37,"O2HB",?44,"COHB",?49,"MHB",?56,"HB",?61,"FiO2",?66,"A-aO2",?73,"QS/QT" X MCFF
- Q:$D(MCOUT) W !,?3,"(NORMAL)",?13,"7.36-7.44",?23,"36-44",?29,"80-100",?36,">88%",?44,"<3%",?49,"<2%",?66,"<22",! 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",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 W !,$E(MCTYPEP,1,13),?14,$J(PH,6,3),?21,$J(PACO2,5,1),?27,$J(PAO2,5,1),?35,$J(O2HB,5,1)_"%",?43,$J(COHB,4,1)_"%",?48,$J(MHB,4,1)_"%",?54,$J(HB,5,1),?60,$J(FIO2,5,3),?65,$S(PAAO2:$J(PAAO2,5,0),1:""),?72,$S(QSQT:$J(QSQT,6,2),1:"")
- S:TYPE="R" MCIAO2=PAO2,MCIAO1=PAAO2
- X MCFF Q:$D(MCOUT) W !,"PATIENT TEMPERATURE (C): ",$P(MCREC,U,11)
- 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 ^MCPFTP4
- MCPFTP3 ;WISC/TJK-PFT REPORT-ABGS ;8/25/92 08:43
- +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",?17,"pH ",?23,"pCO2",?29,"pO2",?37,"O2HB",?44,"COHB",?49,"MHB",?56,"HB",?61,"FiO2",?66,"A-aO2",?73,"QS/QT"
- XECUTE MCFF
- +1 IF $DATA(MCOUT)
- QUIT
- WRITE !,?3,"(NORMAL)",?13,"7.36-7.44",?23,"36-44",?29,"80-100",?36,">88%",?44,"<3%",?49,"<2%",?66,"<22",!
- 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",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 WRITE !,$EXTRACT(MCTYPEP,1,13),?14,$JUSTIFY(PH,6,3),?21,$JUSTIFY(PACO2,5,1),?27,$JUSTIFY(PAO2,5,1),?35,...
- ... $JUSTIFY(O2HB,5,1)_"%",?43,$JUSTIFY(COHB,4,1)_"%",?48,$JUSTIFY(MHB,4,1)_"%",?54,$JUSTIFY(HB,5,1),?60,$JUSTIFY(FIO2,5,3),?65,$SELECT(PAAO2:$JUSTIFY(PAAO2,5,0),1:""),?72,$SELECT(QSQT:$JUSTIFY(QSQT,6,2),1:"")
- +1 IF TYPE="R"
- SET MCIAO2=PAO2
- SET MCIAO1=PAAO2
- +2 XECUTE MCFF
- IF $DATA(MCOUT)
- QUIT
- WRITE !,"PATIENT TEMPERATURE (C): ",$PIECE(MCREC,U,11)
- +3 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 ^MCPFTP4
