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=""
Q
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=""
Q
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=""
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPFTP2 3662 printed Dec 13, 2024@01:43:10 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
