MCBPFTP4.m

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 ---MCBPFTP4   1083     printed  Apr 09, 2024@21:14:41                                                                                                                                                                                                    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