Routine: MDPFTP2

MDPFTP2 ; HOIFO/NCA - PFT REPORT-VOLUMES ;3/15/04  10:00

 ;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004

 D SETVAR G FLOW:'$D(^MCAR(700,+MDR,3)),FLOW:'$O(^(3,0)) S MCX=0

 S HEAD1="VOLUMES" D HEAD1,HEAD2

VOL S MCMAIN=0,MCX=$O(^MCAR(700,+MDR,3,MCX)) G FLOW:MCX'?1N.N S MCREC=^(MCX,0),TYPE=$P(MCREC,U) S:(TYPE="I")!(TYPE="B") MCMAIN=1

 S ND="AV",ND1=3 D PRETEST S SS=""

 D SETNODE(MDGRS," ")

 S SS="     "_$S(TYPE="B":"BODY BOX",TYPE="I":"INERT GAS DILUTION",TYPE="N":"NITROGEN WASH OUT",1:"X-RAY PLANIMETRY") D PREVDATE

 I $P(MCREC,U,6)'="" S SS="(NOTES): "_$P(MCREC,U,6) D SETNODE(MDGRS,SS) S SS=""

 S ACT=$P(MCREC,U,2) I ACT S MEAS="TLC",UNITS="L",PRED=TLC X:$D(MCRC1) MCRC1 S PC=2,CI95=$S(PRED:PRED-CTLC,1:"") D PRTLINE S:MCMAIN MCTLCN=ACT,MCITL=CI95,MCIPTL=PRED

 S ACT=$P(MCREC,U,3) I ACT S MEAS="VC",UNITS="L",PRED=VC X:$D(MCRC1) MCRC1 S PC=3,CI95=$S(PRED:PRED-CVC,1:"") D PRTLINE S:MCMAIN MCVCN=ACT

 S ACT=$P(MCREC,U,4) I ACT S MEAS="FRC",UNITS="L",PRED=FRC X:$D(MCRC3) MCRC3 S PC=4,CI95=$S(PRED:PRED+CFRC,1:"") D PRTLINU

 S ACT=$P(MCREC,U,5) I ACT S MEAS="RV",UNITS="L",PRED=RV X:$D(MCRC3) MCRC3 S PC=5,CI95=$S(PRED:PRED+CRV,1:"") D PRTLINU

 I $P(MCREC,U,2),$P(MCREC,U,5) S SS="     "_"RV/TLC"_"       %" S ACT=$P(MCREC,U,5)/$P(MCREC,U,2) S SS=SS_$J(" ",35-$L(SS))_$J(ACT*100,5,0) D SETNODE(MDGRS,SS) S:MCMAIN&(ACT>.35) MCIRV=1

 G VOL

FLOW K CTLC,CVC,CFRC,CRV G ^MDPFTP2A

EXIT Q

SETVAR S (MCVCN,MCTLCN,MCMVVN,MCIRV,MCIFA,MCIFL,MCIPTL,MCIFE,MCIFV,MCIDA,MCIDL,MCIDP,MCIAO2,MCIAO1,MCITL)="",MCDL=2,MCLNG=5,PRED=0 Q

PRTLINE S MCP1=$G(MCP1),MCP2=$G(MCP2),SS=""

 S SS="     "_MEAS,SS=SS_$J(" ",18-$L(SS))_UNITS,SS=SS_$J("",25-$L(SS))_$S(PRED:$J(PRED,MCLNG,MCDL),1:"")

 S SS=SS_$J(" ",35-$L(SS))_$J(ACT,MCLNG,MCDL),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)

 D SETNODE(MDGRS,SS) S SS="" Q

PRTLINU S SS="" S SS="     "_MEAS,SS=SS_$J(" ",18-$L(SS))_UNITS,SS=SS_$J(" ",25-$L(SS))_$S(PRED:$J(PRED,MCLNG,MCDL),1:"")

 S SS=SS_$J(" ",35-$L(SS))_$J(ACT,MCLNG,MCDL),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))_"U"_$J(CI95,6,2)

 D SETNODE(MDGRS,SS) S SS=""

HEAD1 D SETNODE(MDGRS," "),SETNODE(MDGRS," ")

 S SS=$J(" ",15)_"UNITS"_"     "_$S('$D(MCSP):"PRED",1:"")

 S SS=SS_$J(" ",35-$L(SS))_"ACTUAL"_"     "_$S('$D(MCSP):"%PRED",1:"")

 S SS=SS_$J(" ",55-$L(SS))_"PREV1"_"     "_"PREV2"

 I '$D(MCSP) S SS=SS_$J(" ",73-$L(SS))_"CI"

 D SETNODE(MDGRS,SS) S SS=""

HEAD2 D SETNODE(MDGRS,HEAD1_$E(MCDOT,1,80-$L(HEAD1))) Q

PREVDATE F I="RDATE1","RDATE2" I $D(@I),@I S X=9999999.9999-@I S TAB=$S(I="RDATE1":55,1:65) S SS=SS_$J(" ",TAB-$L(SS))_+$E(X,4,5)_"/"_+$E(X,6,7)_"/"_$E(X,2,3)

 D SETNODE(MDGRS,SS) S SS=""

PRETEST S (MCP1,MCP2,MCP1S0,MCP2S0,MCP1S1,MCP1S2,MCP2S1,MCP2S2,RDATE1,RDATE2)=""

 Q:'$O(^MCAR(700,ND,DFN,TYPE,RDATE))  S RDATE1=$O(^(RDATE)),PD11=$O(^(RDATE1,0)),PD1=$O(^(PD11,0))

 S (MCP1,MCP1S0)=^MCAR(700,PD11,ND1,PD1,0) I ND="AS" S:$D(^(1)) MCP1S1=^(1) S:$D(^(2)) MCP1S2=^(2)

 K PD1,PD11 Q:'$O(^MCAR(700,ND,DFN,TYPE,RDATE1))  S RDATE2=$O(^(RDATE1)),PD21=$O(^(RDATE2,0)),PD2=$O(^(PD21,0))

 S (MCP2,MCP2S0)=^MCAR(700,PD21,ND1,PD2,0) I ND="AS" S:$D(^(1)) MCP2S1=^(1) S:$D(^(2)) MCP2S2=^(2)

 K PD2,PD21 Q

SETNODE(NODE,VALUE) ;Set the node with the string

 S MDLNE=MDLNE+1,@NODE@(MDLNE,0)=VALUE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPFTP2   3662     printed  Mar 13, 2025@20:47:50                                                                                                                                                                                                     Page 2

MDPFTP2   ; HOIFO/NCA - PFT REPORT-VOLUMES ;3/15/04  10:00

 +1       ;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004

 +2        DO SETVAR

           if '$DATA(^MCAR(700,+MDR,3))

               GOTO FLOW

           if '$ORDER(^(3,0))

               GOTO FLOW

           SET MCX=0

 +3        SET HEAD1="VOLUMES"

           DO HEAD1

           DO HEAD2

VOL        SET MCMAIN=0

           SET MCX=$ORDER(^MCAR(700,+MDR,3,MCX))

           if MCX'?1N.N

               GOTO FLOW

           SET MCREC=^(MCX,0)

           SET TYPE=$PIECE(MCREC,U)

           if (TYPE="I")!(TYPE="B")

               SET MCMAIN=1

 +1        SET ND="AV"

           SET ND1=3

           DO PRETEST

           SET SS=""

 +2        DO SETNODE(MDGRS," ")

 +3        SET SS="     "_$SELECT(TYPE="B":"BODY BOX",TYPE="I":"INERT GAS DILUTION",TYPE="N":"NITROGEN WASH OUT",1:"X-RAY PLANIMETRY")

           DO PREVDATE

 +4        IF $PIECE(MCREC,U,6)'=""

               SET SS="(NOTES): "_$PIECE(MCREC,U,6)

               DO SETNODE(MDGRS,SS)

               SET SS=""

 +5        SET ACT=$PIECE(MCREC,U,2)

           IF ACT

               SET MEAS="TLC"

               SET UNITS="L"

               SET PRED=TLC

               if $DATA(MCRC1)

                   XECUTE MCRC1

               SET PC=2

               SET CI95=$SELECT(PRED:PRED-CTLC,1:"")

               DO PRTLINE

               if MCMAIN

                   SET MCTLCN=ACT

                   SET MCITL=CI95

                   SET MCIPTL=PRED

 +6        SET ACT=$PIECE(MCREC,U,3)

           IF ACT

               SET MEAS="VC"

               SET UNITS="L"

               SET PRED=VC

               if $DATA(MCRC1)

                   XECUTE MCRC1

               SET PC=3

               SET CI95=$SELECT(PRED:PRED-CVC,1:"")

               DO PRTLINE

               if MCMAIN

                   SET MCVCN=ACT

 +7        SET ACT=$PIECE(MCREC,U,4)

           IF ACT

               SET MEAS="FRC"

               SET UNITS="L"

               SET PRED=FRC

               if $DATA(MCRC3)

                   XECUTE MCRC3

               SET PC=4

               SET CI95=$SELECT(PRED:PRED+CFRC,1:"")

               DO PRTLINU

 +8        SET ACT=$PIECE(MCREC,U,5)

           IF ACT

               SET MEAS="RV"

               SET UNITS="L"

               SET PRED=RV

               if $DATA(MCRC3)

                   XECUTE MCRC3

               SET PC=5

               SET CI95=$SELECT(PRED:PRED+CRV,1:"")

               DO PRTLINU

 +9        IF $PIECE(MCREC,U,2)

               IF $PIECE(MCREC,U,5)

                   SET SS="     "_"RV/TLC"_"       %"

                   SET ACT=$PIECE(MCREC,U,5)/$PIECE(MCREC,U,2)

                   SET SS=SS_$JUSTIFY(" ",35-$LENGTH(SS))_$JUSTIFY(ACT*100,5,0)

                   DO SETNODE(MDGRS,SS)

                   if MCMAIN&(ACT>.35)

                       SET MCIRV=1

 +10       GOTO VOL

FLOW       KILL CTLC,CVC,CFRC,CRV

           GOTO ^MDPFTP2A

EXIT       QUIT

SETVAR     SET (MCVCN,MCTLCN,MCMVVN,MCIRV,MCIFA,MCIFL,MCIPTL,MCIFE,MCIFV,MCIDA,MCIDL,MCIDP,MCIAO2,MCIAO1,MCITL)=""

           SET MCDL=2

           SET MCLNG=5

           SET PRED=0

           QUIT

PRTLINE    SET MCP1=$GET(MCP1)

           SET MCP2=$GET(MCP2)

           SET SS=""

 +1        SET SS="     "_MEAS

           SET SS=SS_$JUSTIFY(" ",18-$LENGTH(SS))_UNITS

           SET SS=SS_$JUSTIFY("",25-$LENGTH(SS))_$SELECT(PRED:$JUSTIFY(PRED,MCLNG,MCDL),1:"")

 +2        SET SS=SS_$JUSTIFY(" ",35-$LENGTH(SS))_$JUSTIFY(ACT,MCLNG,MCDL)

           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)

           if $PIECE(MCP2,U,PC)

               SET SS=SS_$JUSTIFY(" ",65-$LENGTH(SS))_$JUSTIFY($PIECE(MCP2,U,PC),MCLNG,MCDL)

 +4        if (CI95)&(CI95'=PRED)

               SET SS=SS_$JUSTIFY(" ",72-$LENGTH(SS))_" "_$JUSTIFY(CI95,6,2)

 +5        DO SETNODE(MDGRS,SS)

           SET SS=""

           QUIT

PRTLINU    SET SS=""

           SET SS="     "_MEAS

           SET SS=SS_$JUSTIFY(" ",18-$LENGTH(SS))_UNITS

           SET SS=SS_$JUSTIFY(" ",25-$LENGTH(SS))_$SELECT(PRED:$JUSTIFY(PRED,MCLNG,MCDL),1:"")

 +1        SET SS=SS_$JUSTIFY(" ",35-$LENGTH(SS))_$JUSTIFY(ACT,MCLNG,MCDL)

           SET SS=SS_$JUSTIFY(" ",45-$LENGTH(SS))_$SELECT(PRED:$JUSTIFY(ACT/PRED*100,5,1),1:"")

 +2        if $PIECE(MCP1,U,PC)

               SET SS=SS_$JUSTIFY(" ",55-$LENGTH(SS))_$JUSTIFY($PIECE(MCP1,U,PC),MCLNG,MCDL)

           if $PIECE(MCP2,U,PC)

               SET SS=SS_$JUSTIFY(" ",65-$LENGTH(SS))_$JUSTIFY($PIECE(MCP2,U,PC),MCLNG,MCDL)

 +3        if (CI95)&(CI95'=PRED)

               SET SS=SS_$JUSTIFY(" ",72-$LENGTH(SS))_"U"_$JUSTIFY(CI95,6,2)

 +4        DO SETNODE(MDGRS,SS)

           SET SS=""

 +5        QUIT

HEAD1      DO SETNODE(MDGRS," ")

           DO SETNODE(MDGRS," ")

 +1        SET SS=$JUSTIFY(" ",15)_"UNITS"_"     "_$SELECT('$DATA(MCSP):"PRED",1:"")

 +2        SET SS=SS_$JUSTIFY(" ",35-$LENGTH(SS))_"ACTUAL"_"     "_$SELECT('$DATA(MCSP):"%PRED",1:"")

 +3        SET SS=SS_$JUSTIFY(" ",55-$LENGTH(SS))_"PREV1"_"     "_"PREV2"

 +4        IF '$DATA(MCSP)

               SET SS=SS_$JUSTIFY(" ",73-$LENGTH(SS))_"CI"

 +5        DO SETNODE(MDGRS,SS)

           SET SS=""

 +6        QUIT

HEAD2      DO SETNODE(MDGRS,HEAD1_$EXTRACT(MCDOT,1,80-$LENGTH(HEAD1)))

           QUIT

PREVDATE   FOR I="RDATE1","RDATE2"

               IF $DATA(@I)

                   IF @I

                       SET X=9999999.9999-@I

                       SET TAB=$SELECT(I="RDATE1":55,1:65)

                       SET SS=SS_$JUSTIFY(" ",TAB-$LENGTH(SS))_+$EXTRACT(X,4,5)_"/"_+$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)

 +1        DO SETNODE(MDGRS,SS)

           SET SS=""

 +2        QUIT

PRETEST    SET (MCP1,MCP2,MCP1S0,MCP2S0,MCP1S1,MCP1S2,MCP2S1,MCP2S2,RDATE1,RDATE2)=""

 +1        if '$ORDER(^MCAR(700,ND,DFN,TYPE,RDATE))

               QUIT

           SET RDATE1=$ORDER(^(RDATE))

           SET PD11=$ORDER(^(RDATE1,0))

           SET PD1=$ORDER(^(PD11,0))

 +2        SET (MCP1,MCP1S0)=^MCAR(700,PD11,ND1,PD1,0)

           IF ND="AS"

               if $DATA(^(1))

                   SET MCP1S1=^(1)

               if $DATA(^(2))

                   SET MCP1S2=^(2)

 +3        KILL PD1,PD11

           if '$ORDER(^MCAR(700,ND,DFN,TYPE,RDATE1))

               QUIT

           SET RDATE2=$ORDER(^(RDATE1))

           SET PD21=$ORDER(^(RDATE2,0))

           SET PD2=$ORDER(^(PD21,0))

 +4        SET (MCP2,MCP2S0)=^MCAR(700,PD21,ND1,PD2,0)

           IF ND="AS"

               if $DATA(^(1))

                   SET MCP2S1=^(1)

               if $DATA(^(2))

                   SET MCP2S2=^(2)

 +5        KILL PD2,PD21

           QUIT

SETNODE(NODE,VALUE) ;Set the node with the string

 +1        SET MDLNE=MDLNE+1

           SET @NODE@(MDLNE,0)=VALUE

 +2        QUIT

MDPFTP2.m