108 lines
5.8 KiB
Mathematica
108 lines
5.8 KiB
Mathematica
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
|