MDPFTP1 ;HOIFO/NCA - PFT REPORT-DEMO INFO ;3/15/04 11:55
;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004
; Reference IA #10061 for VADPT call.
; #10040 for HOSPITAL LOCATION FILE #44.
; #10060 for NEW PERSON file #200.
; #3175 for measurement API XLFMSMT
; ------------------------
; SSN = Enternal Format of the patients SSN with the first letter
; of the last name tacked on the end
; ------------------------
GET(MDGRS,MDF,MDR,MDPNAM,MDLNE,MDH) ; Return the PFT report in MDGRS
Q:'$G(MDR) N DFN
S MCPFT0=$G(^MCAR(700,+MDR,0)),DFN=$P(MCPFT0,U,2) Q:MCPFT0=""
D DEM^VADPT S MCARGNM=VADM(1),SSN=VA("PID")
S X1=$E($P(MCPFT0,U),1,7),X2=$P(VADM(3),U)
; ---------------------
; AGE = the patients age at the date of the procedure
; ---------------------
S AGE=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7))
S RACE=$P(VADM(8),U,2),CLIN="" S:$P(MCPFT0,U,10) CLIN=$P(MCPFT0,U,10) I CLIN,$D(^SC(CLIN,0)) S CLIN=$P(^(0),U)
N MCHOLD S MCHOLD=RACE,RACE=$$ETHN(MCHOLD,.VADM)
S DATE=$P(MCPFT0,U),DATE=+$E(DATE,4,5)_"/"_+$E(DATE,6,7)_"/"_$E(DATE,2,3)_$S($P(DATE,".",2):"@"_+$E(DATE,9,10)_":"_$S($L($E(DATE,11,12))=2:$E(DATE,11,12),$L($E(DATE,11,12))=1:$E(DATE,11)_"0",1:"00"),1:"")
N HTCM,HTIN,WTKG,WTLB
S (HTIN,HT1)=$P(MCPFT0,U,4),(HTCM,HT)=$P($$LENGTH^XLFMSMT(HTIN,"IN","CM")," ")
S (WTLB,WT1)=$P(MCPFT0,U,5),(WTKG,WT)=$P($$WEIGHT^XLFMSMT(WTLB,"LB","KG")," ")
I HT'>0 S (HTCM,HT)=$P(MCPFT0,U,3),(HTIN,HT1)=$P($$LENGTH^XLFMSMT(HTCM,"CM","IN")," ")
I WT'>0 S (WTKG,WT)=$P(MCPFT0,U,6),(WTLB,WT1)=$P($$WEIGHT^XLFMSMT(WTKG,"KG","LB")," ")
S $P(MCDOT,".",81)=""
S (MC17,MCEFF,MCSEX)="" S:$D(^MCAR(700,+MDR,17)) MC17=^(17),MCEFF=$P(MC17,U,6),MCEFF=$S(MCEFF="G":"GOOD",MCEFF="E":"EXCELLENT",MCEFF="P":"POOR",1:"")
S MCSEX=$P(VADM(5),U),X=$P(VADM(3),"^",2) S MCARDOB=$S(X'="":X,1:""),X=$P(MCPFT0,U) D DTIME^MCARP S (MCARGDT,MCARGDT2)=X
D INP^VADPT S MCARWARD=$S(VAIN(4)'="":$P(VAIN(4),U,2),1:"NOT INPATIENT"),MCARRB=VAIN(5) D NOW^%DTC S X=% D DTIME^MCARP S MCARDTM=X
D HEAD^MDPS2
S SS="SEX: "_MCSEX_" AGE: "_AGE_$J(" ",10)_+$J(HT1,0,2)_" in/"_+$J(WT1,0,1)_" lb"
S SS=SS_$J(" ",60-$L(SS))_"AMBIENT: "_$P(MCPFT0,U,12)_"C/"_$P(MCPFT0,U,7)_"T" K HT1,WT1 D SETNODE(MDGRS,SS) S SS=""
S SS="RACE: "_RACE S TECH=$P(MCPFT0,U,13) I TECH,$$GET1^DIQ(200,TECH_",",.01)'="" S TECH=$$GET1^DIQ(200,TECH_",",.01)
I $L(RACE)>60 D SETNODE(MDGRS,SS) S SS=""
S SS=SS_$J(" ",60-$L(SS))_"TECH: "_$E(TECH,1,14) D SETNODE(MDGRS,SS) S SS=""
S SS=$S($P(MCPFT0,U,8)="Y":"SMOKER",$P(MCPFT0,U,8)="N":"NON-SMOKER",1:"")
S SS=SS_$J(" ",30-$L(SS))_$S($P(MCPFT0,U,9)="Y":"CURRENT BRONCHODILATOR USE",1:"")
S SS=SS_$J(" ",60-$L(SS))_"EFFORT: "_MCEFF D SETNODE(MDGRS,SS)
K ^UTILITY("DIQ1",$J) D SETNODE^MDPFTP1(MDGRS," "),SETNODE^MDPFTP1(MDGRS,"CONSULT DX: ") S DR(700.01)=.01,DIQ(0)="E",DIC="^MCAR(700,"
F K=0:0 S K=$O(^MCAR(700,MDR,1,K)) Q:K'?1N.N S DA=MDR,DA(700.01)=K,DR=11,DIQ(0)="E" D EN^DIQ1 I $D(^UTILITY("DIQ1",$J,700.01,K,.01,"E"))#2 D SETNODE(MDGRS,$J(" ",15)_$G(^("E")))
K ^UTILITY("DIQ1",$J),DIQ D SETNODE(MDGRS,MCDOT) D PRED
S RDATE=9999999.9999-$P(MCPFT0,U)
D:$D(MCRCN) SETNODE(MDGRS,MCRCN)
D ^MDPFTP2,FOOTER^MDPS2
EXIT ; End of PFT Report process
K ^UTILITY($J),MCOUT,ACT,AGE,CK,CLIN,D0,D1,DA,DATE,CI95
K HB,PH,PACO2,PAO2,O2HB,COHB,FIO2,MHB,PAAO2,QSQT,CAO2,CVO2
K DIC,DIW,DIWL,DIWR,DIWT,DLCOSB,DN,MCDOT,DR,FEV1,FRC,FVC,MC17
K HT,I,J,K,MCARGNM,MCFF,MCK,MCN,MCPI,MCREC,MCREC1,MCVCN
K MCREC2,MCTLCN,MCVN,MCX,MEAS,FEF2575,ND,ND1,P1,P2,PC,PD1,PD11,MCEFF
K PD2,PD21,PF,MCPFT0,PG,PRED,MCPV,RACE,RDATE,RDATE1,RDATE2,RV,MCSEX
K SSN,TAB,TECH,TLC,TYPE,UNIT,UNITS,VC,WT,X,Z,VA,MCRCN
K MCMVVN,MVV,PMVV,MCSP,MCP1S0,MCP1S1,MCP1S2,MCP2S0,MCP2S1,MCP2S2
K CDLCOSB,MCIAO1,MCIAO2,MCIDA,MCIDL,MCIDP,MCIFA,MCIFE
K MCIFL,MCIFV,MCIPTL,MCIRV,MCITL,MCMAIN,MCP1,MCP2,MCRC,MCRCR
K MCTYPEP,MCY,MCRC1,MCRC2,MCRC3,MCRC4,MCSTAT,MCFOOTER,MCOUNT
K MCARRB,MCARDOB,MCARWARD,MCARDTM,MCARHDR,MCARZ,MCARGDT,MCARGDT2,MCDL,MCLNG
D KVAR^VADPT
Q
PRED S (DLCOSB,FEV1,FRC,FVC,FEF2575,PF,RV,TLC,VC,MVV,CTLC,CVC,CFRC,CRV,CFVC,CFEV1,CPF,CFEF2575,CMVV,CDLCOSB,ACT,COHB)=""
S MCPV=$$MCPV(+MDR)
I ('HT)!('WT)!('AGE)!(MCPV=0) Q
D PREDS,MCRACE Q
MCRACE S MCRCR="",MCRC=$G(^MCAR(700.1,MCPV,"RC")) Q:MCRC=""
S MCRCR=$G(^MCAR(700,+MDR,17)) Q:MCRCR="" Q:$P(MCRCR,U,5)'="Y"
N MCRAC,MCMRAC S MCMRAC=0
S:RACE["ASIAN" MCMRAC=MCMRAC+1
S:RACE["BLACK" MCMRAC=MCMRAC+1
I MCMRAC>1 S MCRAC=$P(MCRCR,U,7),MCRAC=$S(MCRAC="A":"O",1:MCRAC)
S MCRCR=$S(RACE["BLACK":"B",RACE["ASIAN":"O",1:"") Q:MCRCR=""
I MCMRAC>1 S MCRCR=MCRAC Q:MCRCR=""
F I=1:1:6 I $P(MCRC,U,I) S J=$P(MCRC,U,I) D:J
.Q:'$D(^MCAR(700.2,J,0)) S J=$P(^(0),U,1)
.S @("MCRC"_I)="S PRED="_J
K J G ORIENTAL:MCRCR="O" K MCRC2,MCRC6
I '$D(MCRC1),'$D(MCRC3),'$D(MCRC4),'$D(MCRC5) Q
S:$D(MCRC1) MCRCN="TLC,VC,FVC,FEV1" S:$D(MCRC3) MCRCN=MCRCN_",FRC,RV" S:$D(MCRC4) MCRCN=MCRCN_",FEF25-75" S:$D(MCRC5) MCRCN=MCRCN_",MVV" S:$E(MCRCN,1)="," MCRCN=$E(MCRCN,2,35)
G NOTE
SETNODE(NODE,VALUE) ;Set the node with the string
S MDLNE=MDLNE+1,@NODE@(MDLNE,0)=VALUE
Q
ORIENTAL I '$D(MCRC2),'$D(MCRC6) K MCRC1,MCRC3,MCRC4,MCRC5 Q
S:$D(MCRC2) MCRC1=MCRC2 S:$D(MCRC6) MCRC5=MCRC6 K MCRC3,MCRC4,MCRC6 S MCRCN="TLC,VC,FVC,FEV1,MVV"
NOTE S MCRCN="NOTE: Race Correction on predicted values: "_MCRCN
I $G(MCMRAC)>1 S MCRCN=MCRCN_$S(MCRCR="O":" - ASIAN",1:" - BLACK")
Q
CONFID(MCPV,VALUE) ;
Q $P(^MCAR(700.2,^MCAR(700.1,MCPV,VALUE),0),U,5)
PREDV(MCPV,VALUE) ;
N EXPRESS,FORMULA,IEN,RESULT
S IEN=+$P($G(^MCAR(700.1,MCPV,VALUE)),U)
S FORMULA=$P($G(^MCAR(700.2,IEN,0)),U)
S RESULT=""
I FORMULA]"" S EXPRESS="S RESULT="_FORMULA X EXPRESS
Q $S(RESULT]"":RESULT,1:"")
MCPV(MCDA) ; Get the Predicted Value entry
Q $S($D(^MCAR(700,MCDA,"PV")):^("PV"),1:0)
PREDS S BSA=+$$BSA(HT,WT),I="DLCOSB",DLCOSB=$$PREDV(MCPV,"DLCOSB"),CDLCOSB=$$CONFID(MCPV,"DLCOSB")
S FEV1=$$PREDV(MCPV,"FEV1"),CFEV1=$$CONFID(MCPV,"FEV1")
S FRC=$$PREDV(MCPV,"FRC"),CFRC=$$CONFID(MCPV,"FRC")
S FVC=$$PREDV(MCPV,"FVC"),CFVC=$$CONFID(MCPV,"FVC")
S FEF2575=$$PREDV(MCPV,"FEF2575"),CFEF2575=$$CONFID(MCPV,"FEF2575")
S PF=$$PREDV(MCPV,"PF"),CPF=$$CONFID(MCPV,"PF")
S RV=$$PREDV(MCPV,"RV"),CRV=$$CONFID(MCPV,"RV")
S TLC=$$PREDV(MCPV,"TLC"),CTLC=$$CONFID(MCPV,"TLC")
S VC=$$PREDV(MCPV,"VC"),CVC=$$CONFID(MCPV,"VC")
S MVV=$$PREDV(MCPV,"MVV"),CMVV=$$CONFID(MCPV,"MVV")
Q
BSA(HT,WT) ; Compute BSA
D COMPUTE^MCARBSA
Q X
ETHN(MCRSTR,MCETH) ; Get the Race and Ethnicity arrays and concat with Race
N MCCTR,MCSTR,MCLP,MCX,Y
S MCCTR=+$G(MCETH(12)),MCSTR=""
I MCCTR F MCLP=1:1:MCCTR S MDX=$G(MCETH(12,MCLP)) S:$P(MDX,"^",2)'="" MCSTR=MCSTR_$S(MCSTR="":"",1:", ")_$P(MDX,"^",2)
S Y=$S(MCSTR'="":MCSTR,1:MCRSTR)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPFTP1 6755 printed Dec 13, 2024@01:43:09 Page 2
MDPFTP1 ;HOIFO/NCA - PFT REPORT-DEMO INFO ;3/15/04 11:55
+1 ;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004
+2 ; Reference IA #10061 for VADPT call.
+3 ; #10040 for HOSPITAL LOCATION FILE #44.
+4 ; #10060 for NEW PERSON file #200.
+5 ; #3175 for measurement API XLFMSMT
+6 ; ------------------------
+7 ; SSN = Enternal Format of the patients SSN with the first letter
+8 ; of the last name tacked on the end
+9 ; ------------------------
GET(MDGRS,MDF,MDR,MDPNAM,MDLNE,MDH) ; Return the PFT report in MDGRS
+1 if '$GET(MDR)
QUIT
NEW DFN
+2 SET MCPFT0=$GET(^MCAR(700,+MDR,0))
SET DFN=$PIECE(MCPFT0,U,2)
if MCPFT0=""
QUIT
+3 DO DEM^VADPT
SET MCARGNM=VADM(1)
SET SSN=VA("PID")
+4 SET X1=$EXTRACT($PIECE(MCPFT0,U),1,7)
SET X2=$PIECE(VADM(3),U)
+5 ; ---------------------
+6 ; AGE = the patients age at the date of the procedure
+7 ; ---------------------
+8 SET AGE=$EXTRACT(X1,1,3)-$EXTRACT(X2,1,3)-($EXTRACT(X1,4,7)<$EXTRACT(X2,4,7))
+9 SET RACE=$PIECE(VADM(8),U,2)
SET CLIN=""
if $PIECE(MCPFT0,U,10)
SET CLIN=$PIECE(MCPFT0,U,10)
IF CLIN
IF $DATA(^SC(CLIN,0))
SET CLIN=$PIECE(^(0),U)
+10 NEW MCHOLD
SET MCHOLD=RACE
SET RACE=$$ETHN(MCHOLD,.VADM)
+11 SET DATE=$PIECE(MCPFT0,U)
SET DATE=+$EXTRACT(DATE,4,5)_"/"_+$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)_$SELECT($PIECE(DATE,".",2):"@"_+$EXTRACT(DATE,9,10)_":"_$SELECT($LENGTH($EXTRACT(DATE,11,12))=2:$EXTRACT(DATE,11,12),$LENGTH($EXTRACT(DATE,11,12))=1:...
... $EXTRACT(DATE,11)_"0",1:"00"),1:"")
+12 NEW HTCM,HTIN,WTKG,WTLB
+13 SET (HTIN,HT1)=$PIECE(MCPFT0,U,4)
SET (HTCM,HT)=$PIECE($$LENGTH^XLFMSMT(HTIN,"IN","CM")," ")
+14 SET (WTLB,WT1)=$PIECE(MCPFT0,U,5)
SET (WTKG,WT)=$PIECE($$WEIGHT^XLFMSMT(WTLB,"LB","KG")," ")
+15 IF HT'>0
SET (HTCM,HT)=$PIECE(MCPFT0,U,3)
SET (HTIN,HT1)=$PIECE($$LENGTH^XLFMSMT(HTCM,"CM","IN")," ")
+16 IF WT'>0
SET (WTKG,WT)=$PIECE(MCPFT0,U,6)
SET (WTLB,WT1)=$PIECE($$WEIGHT^XLFMSMT(WTKG,"KG","LB")," ")
+17 SET $PIECE(MCDOT,".",81)=""
+18 SET (MC17,MCEFF,MCSEX)=""
if $DATA(^MCAR(700,+MDR,17))
SET MC17=^(17)
SET MCEFF=$PIECE(MC17,U,6)
SET MCEFF=$SELECT(MCEFF="G":"GOOD",MCEFF="E":"EXCELLENT",MCEFF="P":"POOR",1:"")
+19 SET MCSEX=$PIECE(VADM(5),U)
SET X=$PIECE(VADM(3),"^",2)
SET MCARDOB=$SELECT(X'="":X,1:"")
SET X=$PIECE(MCPFT0,U)
DO DTIME^MCARP
SET (MCARGDT,MCARGDT2)=X
+20 DO INP^VADPT
SET MCARWARD=$SELECT(VAIN(4)'="":$PIECE(VAIN(4),U,2),1:"NOT INPATIENT")
SET MCARRB=VAIN(5)
DO NOW^%DTC
SET X=%
DO DTIME^MCARP
SET MCARDTM=X
+21 DO HEAD^MDPS2
+22 SET SS="SEX: "_MCSEX_" AGE: "_AGE_$JUSTIFY(" ",10)_+$JUSTIFY(HT1,0,2)_" in/"_+$JUSTIFY(WT1,0,1)_" lb"
+23 SET SS=SS_$JUSTIFY(" ",60-$LENGTH(SS))_"AMBIENT: "_$PIECE(MCPFT0,U,12)_"C/"_$PIECE(MCPFT0,U,7)_"T"
KILL HT1,WT1
DO SETNODE(MDGRS,SS)
SET SS=""
+24 SET SS="RACE: "_RACE
SET TECH=$PIECE(MCPFT0,U,13)
IF TECH
IF $$GET1^DIQ(200,TECH_",",.01)'=""
SET TECH=$$GET1^DIQ(200,TECH_",",.01)
+25 IF $LENGTH(RACE)>60
DO SETNODE(MDGRS,SS)
SET SS=""
+26 SET SS=SS_$JUSTIFY(" ",60-$LENGTH(SS))_"TECH: "_$EXTRACT(TECH,1,14)
DO SETNODE(MDGRS,SS)
SET SS=""
+27 SET SS=$SELECT($PIECE(MCPFT0,U,8)="Y":"SMOKER",$PIECE(MCPFT0,U,8)="N":"NON-SMOKER",1:"")
+28 SET SS=SS_$JUSTIFY(" ",30-$LENGTH(SS))_$SELECT($PIECE(MCPFT0,U,9)="Y":"CURRENT BRONCHODILATOR USE",1:"")
+29 SET SS=SS_$JUSTIFY(" ",60-$LENGTH(SS))_"EFFORT: "_MCEFF
DO SETNODE(MDGRS,SS)
+30 KILL ^UTILITY("DIQ1",$JOB)
DO SETNODE^MDPFTP1(MDGRS," ")
DO SETNODE^MDPFTP1(MDGRS,"CONSULT DX: ")
SET DR(700.01)=.01
SET DIQ(0)="E"
SET DIC="^MCAR(700,"
+31 FOR K=0:0
SET K=$ORDER(^MCAR(700,MDR,1,K))
if K'?1N.N
QUIT
SET DA=MDR
SET DA(700.01)=K
SET DR=11
SET DIQ(0)="E"
DO EN^DIQ1
IF $DATA(^UTILITY("DIQ1",$JOB,700.01,K,.01,"E"))#2
DO SETNODE(MDGRS,$JUSTIFY(" ",15)_$GET(^("E")))
+32 KILL ^UTILITY("DIQ1",$JOB),DIQ
DO SETNODE(MDGRS,MCDOT)
DO PRED
+33 SET RDATE=9999999.9999-$PIECE(MCPFT0,U)
+34 if $DATA(MCRCN)
DO SETNODE(MDGRS,MCRCN)
+35 DO ^MDPFTP2
DO FOOTER^MDPS2
EXIT ; End of PFT Report process
+1 KILL ^UTILITY($JOB),MCOUT,ACT,AGE,CK,CLIN,D0,D1,DA,DATE,CI95
+2 KILL HB,PH,PACO2,PAO2,O2HB,COHB,FIO2,MHB,PAAO2,QSQT,CAO2,CVO2
+3 KILL DIC,DIW,DIWL,DIWR,DIWT,DLCOSB,DN,MCDOT,DR,FEV1,FRC,FVC,MC17
+4 KILL HT,I,J,K,MCARGNM,MCFF,MCK,MCN,MCPI,MCREC,MCREC1,MCVCN
+5 KILL MCREC2,MCTLCN,MCVN,MCX,MEAS,FEF2575,ND,ND1,P1,P2,PC,PD1,PD11,MCEFF
+6 KILL PD2,PD21,PF,MCPFT0,PG,PRED,MCPV,RACE,RDATE,RDATE1,RDATE2,RV,MCSEX
+7 KILL SSN,TAB,TECH,TLC,TYPE,UNIT,UNITS,VC,WT,X,Z,VA,MCRCN
+8 KILL MCMVVN,MVV,PMVV,MCSP,MCP1S0,MCP1S1,MCP1S2,MCP2S0,MCP2S1,MCP2S2
+9 KILL CDLCOSB,MCIAO1,MCIAO2,MCIDA,MCIDL,MCIDP,MCIFA,MCIFE
+10 KILL MCIFL,MCIFV,MCIPTL,MCIRV,MCITL,MCMAIN,MCP1,MCP2,MCRC,MCRCR
+11 KILL MCTYPEP,MCY,MCRC1,MCRC2,MCRC3,MCRC4,MCSTAT,MCFOOTER,MCOUNT
+12 KILL MCARRB,MCARDOB,MCARWARD,MCARDTM,MCARHDR,MCARZ,MCARGDT,MCARGDT2,MCDL,MCLNG
+13 DO KVAR^VADPT
+14 QUIT
PRED SET (DLCOSB,FEV1,FRC,FVC,FEF2575,PF,RV,TLC,VC,MVV,CTLC,CVC,CFRC,CRV,CFVC,CFEV1,CPF,CFEF2575,CMVV,CDLCOSB,ACT,COHB)=""
+1 SET MCPV=$$MCPV(+MDR)
+2 IF ('HT)!('WT)!('AGE)!(MCPV=0)
QUIT
+3 DO PREDS
DO MCRACE
QUIT
MCRACE SET MCRCR=""
SET MCRC=$GET(^MCAR(700.1,MCPV,"RC"))
if MCRC=""
QUIT
+1 SET MCRCR=$GET(^MCAR(700,+MDR,17))
if MCRCR=""
QUIT
if $PIECE(MCRCR,U,5)'="Y"
QUIT
+2 NEW MCRAC,MCMRAC
SET MCMRAC=0
+3 if RACE["ASIAN"
SET MCMRAC=MCMRAC+1
+4 if RACE["BLACK"
SET MCMRAC=MCMRAC+1
+5 IF MCMRAC>1
SET MCRAC=$PIECE(MCRCR,U,7)
SET MCRAC=$SELECT(MCRAC="A":"O",1:MCRAC)
+6 SET MCRCR=$SELECT(RACE["BLACK":"B",RACE["ASIAN":"O",1:"")
if MCRCR=""
QUIT
+7 IF MCMRAC>1
SET MCRCR=MCRAC
if MCRCR=""
QUIT
+8 FOR I=1:1:6
IF $PIECE(MCRC,U,I)
SET J=$PIECE(MCRC,U,I)
if J
Begin DoDot:1
+9 if '$DATA(^MCAR(700.2,J,0))
QUIT
SET J=$PIECE(^(0),U,1)
+10 SET @("MCRC"_I)="S PRED="_J
End DoDot:1
+11 KILL J
if MCRCR="O"
GOTO ORIENTAL
KILL MCRC2,MCRC6
+12 IF '$DATA(MCRC1)
IF '$DATA(MCRC3)
IF '$DATA(MCRC4)
IF '$DATA(MCRC5)
QUIT
+13 if $DATA(MCRC1)
SET MCRCN="TLC,VC,FVC,FEV1"
if $DATA(MCRC3)
SET MCRCN=MCRCN_",FRC,RV"
if $DATA(MCRC4)
SET MCRCN=MCRCN_",FEF25-75"
if $DATA(MCRC5)
SET MCRCN=MCRCN_",MVV"
if $EXTRACT(MCRCN,1)=","
SET MCRCN=$EXTRACT(MCRCN,2,35)
+14 GOTO NOTE
SETNODE(NODE,VALUE) ;Set the node with the string
+1 SET MDLNE=MDLNE+1
SET @NODE@(MDLNE,0)=VALUE
+2 QUIT
ORIENTAL IF '$DATA(MCRC2)
IF '$DATA(MCRC6)
KILL MCRC1,MCRC3,MCRC4,MCRC5
QUIT
+1 if $DATA(MCRC2)
SET MCRC1=MCRC2
if $DATA(MCRC6)
SET MCRC5=MCRC6
KILL MCRC3,MCRC4,MCRC6
SET MCRCN="TLC,VC,FVC,FEV1,MVV"
NOTE SET MCRCN="NOTE: Race Correction on predicted values: "_MCRCN
+1 IF $GET(MCMRAC)>1
SET MCRCN=MCRCN_$SELECT(MCRCR="O":" - ASIAN",1:" - BLACK")
+2 QUIT
CONFID(MCPV,VALUE) ;
+1 QUIT $PIECE(^MCAR(700.2,^MCAR(700.1,MCPV,VALUE),0),U,5)
PREDV(MCPV,VALUE) ;
+1 NEW EXPRESS,FORMULA,IEN,RESULT
+2 SET IEN=+$PIECE($GET(^MCAR(700.1,MCPV,VALUE)),U)
+3 SET FORMULA=$PIECE($GET(^MCAR(700.2,IEN,0)),U)
+4 SET RESULT=""
+5 IF FORMULA]""
SET EXPRESS="S RESULT="_FORMULA
XECUTE EXPRESS
+6 QUIT $SELECT(RESULT]"":RESULT,1:"")
MCPV(MCDA) ; Get the Predicted Value entry
+1 QUIT $SELECT($DATA(^MCAR(700,MCDA,"PV")):^("PV"),1:0)
PREDS SET BSA=+$$BSA(HT,WT)
SET I="DLCOSB"
SET DLCOSB=$$PREDV(MCPV,"DLCOSB")
SET CDLCOSB=$$CONFID(MCPV,"DLCOSB")
+1 SET FEV1=$$PREDV(MCPV,"FEV1")
SET CFEV1=$$CONFID(MCPV,"FEV1")
+2 SET FRC=$$PREDV(MCPV,"FRC")
SET CFRC=$$CONFID(MCPV,"FRC")
+3 SET FVC=$$PREDV(MCPV,"FVC")
SET CFVC=$$CONFID(MCPV,"FVC")
+4 SET FEF2575=$$PREDV(MCPV,"FEF2575")
SET CFEF2575=$$CONFID(MCPV,"FEF2575")
+5 SET PF=$$PREDV(MCPV,"PF")
SET CPF=$$CONFID(MCPV,"PF")
+6 SET RV=$$PREDV(MCPV,"RV")
SET CRV=$$CONFID(MCPV,"RV")
+7 SET TLC=$$PREDV(MCPV,"TLC")
SET CTLC=$$CONFID(MCPV,"TLC")
+8 SET VC=$$PREDV(MCPV,"VC")
SET CVC=$$CONFID(MCPV,"VC")
+9 SET MVV=$$PREDV(MCPV,"MVV")
SET CMVV=$$CONFID(MCPV,"MVV")
+10 QUIT
BSA(HT,WT) ; Compute BSA
+1 DO COMPUTE^MCARBSA
+2 QUIT X
ETHN(MCRSTR,MCETH) ; Get the Race and Ethnicity arrays and concat with Race
+1 NEW MCCTR,MCSTR,MCLP,MCX,Y
+2 SET MCCTR=+$GET(MCETH(12))
SET MCSTR=""
+3 IF MCCTR
FOR MCLP=1:1:MCCTR
SET MDX=$GET(MCETH(12,MCLP))
if $PIECE(MDX,"^",2)'=""
SET MCSTR=MCSTR_$SELECT(MCSTR="":"",1:", ")_$PIECE(MDX,"^",2)
+4 SET Y=$SELECT(MCSTR'="":MCSTR,1:MCRSTR)
+5 QUIT Y
