- MCPFTP1 ;WISC/TJK-PFT REPORT-DEMO INFO ;1/17/03 11:57
- ;;2.3;Medicine;**14,16,22,25,35**;09/13/1996
- ; 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
- ; ------------------------
- 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 HT1=$P(MCPFT0,U,4),WT1=$P(MCPFT0,U,5) S $P(MCDOT,".",81)=""
- ;S HT=HT1*2.54,WT=WT1/2.2
- ;S:'HT HT=$P(MCPFT0,U,3),HT1=HT/2.54 S:'WT WT=$P(MCPFT0,U,6),WT1=WT*2.2
- S (MC17,MCEFF,MCSEX)="" S:$D(^MCAR(700,MCARGDA,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,MCARZ="PULMONARY FUNCTION TEST " S:MCESON MCARZ=MCARZ_" - "_MCSTAT
- 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 INIT^MCARP1(MCARZ,MCARGDT,MCFILE)
- D HEAD^MCARP
- W !,"SEX: ",MCSEX," AGE:",AGE,?30,+$J(HT1,0,2)," in/",+$J(WT1,0,1)," lb",?60,"AMBIENT: ",$P(MCPFT0,U,12),"C/",$P(MCPFT0,U,7),"T" K HT1,WT1
- W !,"RACE: ",RACE S TECH=$P(MCPFT0,U,13) I TECH,$D(^VA(200,TECH,0)) S TECH=$P(^(0),U)
- W:$L(RACE)>60 !
- W ?60,"TECH: ",$E(TECH,1,14)
- W !,$S($P(MCPFT0,U,8)="Y":"SMOKER",$P(MCPFT0,U,8)="N":"NON-SMOKER",1:"")
- W ?30 W:$P(MCPFT0,U,9)="Y" "CURRENT BRONCHODILATOR USE"
- W ?60,"EFFORT: ",MCEFF
- S MCFF="S DN=1,MCY="""" I $Y>(IOSL-3) R:$E(IOST,1,2)=""C-"" !!,""Press Return to Continue, '^' to escape: "",MCY:DTIME S:'$T MCY=U S:MCY=U MCOUT=1,DN=0 Q:$D(MCOUT) D:DN HEAD^MCARP D:$D(HEAD1) HEAD1^MCPFTP2,HEAD2^MCPFTP2 K MCY"
- K ^UTILITY("DIQ1",$J) W !!,"CONSULT DX: " S DR(700.01)=.01,DIQ(0)="E",DIC="^MCAR(700,"
- F K=0:0 S K=$O(^MCAR(700,MCARGDA,1,K)) Q:K'?1N.N S DA=MCARGDA,DA(700.01)=K,DR=11,DIQ(0)="E" D EN^DIQ1 I $D(^UTILITY("DIQ1",$J,700.01,K,.01,"E"))#2 W ?15,^("E"),! X MCFF Q:$D(MCOUT)
- K ^UTILITY("DIQ1",$J),DIQ Q:$D(MCOUT) W !,MCDOT X MCFF Q:$D(MCOUT) D PRED
- S RDATE=9999999.9999-$P(MCPFT0,U)
- W:$D(MCRCN) !,MCRCN
- D ^MCPFTP2
- I '$D(MCOUT) D:$G(MCESON) FOOTER^MCESPRT(MCFILE,MCARGDA)
- EXIT S:$D(ZTQUEUED) ZTREQ="@" K ZTSK
- EXIT1 ;
- D EXIT^MCPFTP1A
- 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(MCARGDA)
- 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,MCARGDA,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
- 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[HMCPFTP1 6040 printed Jan 18, 2025@03:17:14 Page 2
- MCPFTP1 ;WISC/TJK-PFT REPORT-DEMO INFO ;1/17/03 11:57
- +1 ;;2.3;Medicine;**14,16,22,25,35**;09/13/1996
- +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 ; ------------------------
- +10 DO DEM^VADPT
- SET MCARGNM=VADM(1)
- SET SSN=VA("PID")
- +11 SET X1=$EXTRACT($PIECE(MCPFT0,U),1,7)
- SET X2=$PIECE(VADM(3),U)
- +12 ; ---------------------
- +13 ; AGE = the patients age at the date of the procedure
- +14 ; ---------------------
- +15 SET AGE=$EXTRACT(X1,1,3)-$EXTRACT(X2,1,3)-($EXTRACT(X1,4,7)<$EXTRACT(X2,4,7))
- +16 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)
- +17 NEW MCHOLD
- SET MCHOLD=RACE
- SET RACE=$$ETHN(MCHOLD,.VADM)
- +18 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:"")
- +19 NEW HTCM,HTIN,WTKG,WTLB
- +20 SET (HTIN,HT1)=$PIECE(MCPFT0,U,4)
- SET (HTCM,HT)=$PIECE($$LENGTH^XLFMSMT(HTIN,"IN","CM")," ")
- +21 SET (WTLB,WT1)=$PIECE(MCPFT0,U,5)
- SET (WTKG,WT)=$PIECE($$WEIGHT^XLFMSMT(WTLB,"LB","KG")," ")
- +22 IF HT'>0
- SET (HTCM,HT)=$PIECE(MCPFT0,U,3)
- SET (HTIN,HT1)=$PIECE($$LENGTH^XLFMSMT(HTCM,"CM","IN")," ")
- +23 IF WT'>0
- SET (WTKG,WT)=$PIECE(MCPFT0,U,6)
- SET (WTLB,WT1)=$PIECE($$WEIGHT^XLFMSMT(WTKG,"KG","LB")," ")
- +24 SET $PIECE(MCDOT,".",81)=""
- +25 ;S HT1=$P(MCPFT0,U,4),WT1=$P(MCPFT0,U,5) S $P(MCDOT,".",81)=""
- +26 ;S HT=HT1*2.54,WT=WT1/2.2
- +27 ;S:'HT HT=$P(MCPFT0,U,3),HT1=HT/2.54 S:'WT WT=$P(MCPFT0,U,6),WT1=WT*2.2
- +28 SET (MC17,MCEFF,MCSEX)=""
- if $DATA(^MCAR(700,MCARGDA,17))
- SET MC17=^(17)
- SET MCEFF=$PIECE(MC17,U,6)
- SET MCEFF=$SELECT(MCEFF="G":"GOOD",MCEFF="E":"EXCELLENT",MCEFF="P":"POOR",1:"")
- +29 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
- SET MCARZ="PULMONARY FUNCTION TEST "
- if MCESON
- SET MCARZ=MCARZ_" - "_MCSTAT
- +30 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
- +31 DO INIT^MCARP1(MCARZ,MCARGDT,MCFILE)
- +32 DO HEAD^MCARP
- +33 WRITE !,"SEX: ",MCSEX," AGE:",AGE,?30,+$JUSTIFY(HT1,0,2)," in/",+$JUSTIFY(WT1,0,1)," lb",?60,"AMBIENT: ",$PIECE(MCPFT0,U,12),"C/",$PIECE(MCPFT0,U,7),"T"
- KILL HT1,WT1
- +34 WRITE !,"RACE: ",RACE
- SET TECH=$PIECE(MCPFT0,U,13)
- IF TECH
- IF $DATA(^VA(200,TECH,0))
- SET TECH=$PIECE(^(0),U)
- +35 if $LENGTH(RACE)>60
- WRITE !
- +36 WRITE ?60,"TECH: ",$EXTRACT(TECH,1,14)
- +37 WRITE !,$SELECT($PIECE(MCPFT0,U,8)="Y":"SMOKER",$PIECE(MCPFT0,U,8)="N":"NON-SMOKER",1:"")
- +38 WRITE ?30
- if $PIECE(MCPFT0,U,9)="Y"
- WRITE "CURRENT BRONCHODILATOR USE"
- +39 WRITE ?60,"EFFORT: ",MCEFF
- +40 SET MCFF="S DN=1,MCY="""" I $Y>(IOSL-3) R:$E(IOST,1,2)=""C-"" !!,""Press Return to Continue, '^' to escape: "",MCY:DTIME S:'$T MCY=U S:MCY=U MCOUT=1,DN=0 Q:$D(MCOUT) D:DN HEAD^MCARP D:$D(HEAD1) HEAD1^MCPFTP2,HEAD2^MCPFTP2 K MCY"
- +41 KILL ^UTILITY("DIQ1",$JOB)
- WRITE !!,"CONSULT DX: "
- SET DR(700.01)=.01
- SET DIQ(0)="E"
- SET DIC="^MCAR(700,"
- +42 FOR K=0:0
- SET K=$ORDER(^MCAR(700,MCARGDA,1,K))
- if K'?1N.N
- QUIT
- SET DA=MCARGDA
- 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
- WRITE ?15,^("E"),!
- XECUTE MCFF
- if $DATA(MCOUT)
- QUIT
- +43 KILL ^UTILITY("DIQ1",$JOB),DIQ
- if $DATA(MCOUT)
- QUIT
- WRITE !,MCDOT
- XECUTE MCFF
- if $DATA(MCOUT)
- QUIT
- DO PRED
- +44 SET RDATE=9999999.9999-$PIECE(MCPFT0,U)
- +45 if $DATA(MCRCN)
- WRITE !,MCRCN
- +46 DO ^MCPFTP2
- +47 IF '$DATA(MCOUT)
- if $GET(MCESON)
- DO FOOTER^MCESPRT(MCFILE,MCARGDA)
- EXIT if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL ZTSK
- EXIT1 ;
- +1 DO EXIT^MCPFTP1A
- +2 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(MCARGDA)
- +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,MCARGDA,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
- 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