BQIPTMSR ;PRXM/HC/ALA-Patient Measurements ; 23 Feb 2007 3:17 PM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
Q
;
MSR(DATA,DFN,DRANGE) ; EP -- BQI PATIENT MEASUREMENTS
;
;Description - all the measurements that a patient has
;
;Input
; DFN - Patient internal entry number
; DRANGE - Date range as a relative date ie. T-6M
;
NEW UID,II,IEN,TIEN,TNAME,VISIT,VSDTM,VALUE,OPROV,EPROV,PERCNT
NEW BI,BMI,HDR,IENSMS,ORPHY,EVDTM,QN,N,QUAL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTMSR",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTMSR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S DRANGE=$$DATE^BQIUL1($G(DRANGE))
S @DATA@(II)="I00010MEAS_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00030TYPE_DESC^T00100VALUE^D00030EVENT_DATETIME^N00005PERCENTILE^T01024QUALIF"_$C(30)
S IEN=""
F S IEN=$O(^AUPNVMSR("AC",DFN,IEN),-1) Q:IEN="" D
. S TIEN=$$GET1^DIQ(9000010.01,IEN_",",.01,"I") I TIEN="" Q
. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
. S TNAME=$$GET1^DIQ(9999999.07,TIEN_",",.02,"E")
. S VISIT=$$GET1^DIQ(9000010.01,IEN_",",.03,"I") I VISIT="" Q
. S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSDTM=0 Q
. I DRANGE'="",(VSDTM\1<DRANGE) Q
. S VALUE=$$GET1^DIQ(9000010.01,IEN_",",.04,"E")
. S PERCNT=$$GET1^DIQ(9000010.01,IEN_",",.05,"E") S:PERCNT="" PERCNT=-1
. ;S OPROV=$$GET1^DIQ(9000010.01,IEN_",",1202,"E")
. ;S EPROV=$$GET1^DIQ(9000010.01,IEN_",",1204,"E")
. S EVDTM=$$GET1^DIQ(9000010.01,IEN_",",1201,"I")
. S QUAL="",N=0
. F S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N D
.. S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
.. S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
. S QUAL=$$TKO^BQIUL1(QUAL,"; ")
. S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TNAME_U_VALUE_U_$$FMTE^BQIUL1(EVDTM)_U_PERCNT_U_QUAL_$C(30)
;
; Check for refusals
D REF
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
REF ; Check for refusals
NEW MSRN,RVDT,REVDT,RFIEN,VISIT,PERCNT,TNAME,VALUE
S MSRN=""
F S MSRN=$O(^AUPNPREF("AA",DFN,9999999.07,MSRN)) Q:MSRN="" D
. S RVDT=""
. F S RVDT=$O(^AUPNPREF("AA",DFN,9999999.07,MSRN,RVDT)) Q:RVDT="" D
.. ; Reverse the reverse date
.. S REVDT=9999999-RVDT
.. I DRANGE'="",(REVDT\1)<DRANGE Q
.. S RFIEN=""
.. F S RFIEN=$O(^AUPNPREF("AA",DFN,9999999.07,MSRN,RVDT,RFIEN)) Q:RFIEN="" D
... S TNAME=$$GET1^DIQ(9999999.07,MSRN_",",.01,"E")
... S VALUE=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
... S ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
... S PERCNT=-1,VISIT="",EVDTM=""
... S II=II+1,@DATA@(II)=U_VISIT_U_$$FMTE^BQIUL1(REVDT)_U_TNAME_U_VALUE_U_EVDTM_U_PERCNT_$C(30)
Q
;
LST(DATA,DFN) ;EP -- BQI PATIENT LAST MEASURES
; Input
; DFN - Patient IEN
NEW UID,II,IEN,QUAL,HDR,VISIT,VSDTM,BMI,IENS,BI,TIEN,TNAME,VALUE,BQISORT,MEAS,N
NEW BMID,MSN,QFL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTMSR",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTMSR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="I00010MEAS_IEN^I00010VISIT_IEN^D00030EVENT_VISIT_DATETIME^T00030TYPE_DESC^T00100VALUE^T01024QUALIF^T00010BMI"
S @DATA@(II)=HDR_$C(30)
;
K BQISORT
S IEN=""
F S IEN=$O(^AUPNVMSR("AC",DFN,IEN),-1) Q:IEN="" D
. S VISIT=$$GET1^DIQ(9000010.01,IEN_",",.03,"I") I VISIT="" Q
. S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSDTM=0 Q
. S BQISORT(VSDTM)=VISIT
;
K MEAS
;S BMI=$$OBMI^BQITBMI(DFN,""),QUAL=""
S BMID=$$PBMI^APCLV(DFN,DT),QUAL=""
S BMI=$P(BMID,"^",1)
I BMI'="" D
. F BI=4,7 S VISIT=$P(BMID,"^",BI) D
.. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
.. I BI=4 S TNAME="HEIGHT",VALUE=$P(BMID,"^",2)
.. I BI=7 S TNAME="WEIGHT",VALUE=$P(BMID,"^",5)
.. S MSN=$$FIND1^DIC(9999999.07,,"MX",TNAME)
.. S IEN=$P(BMID,"^",10)
.. I IEN="" D
... S MIEN="",QFL=0
... F S MIEN=$O(^AUPNVMSR("AD",VISIT,MIEN)) Q:MIEN=""!(QFL) D
.... I $P(^AUPNVMSR(MIEN,0),U,1)=MSN S IEN=MIEN,QFL=1
.. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
.. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
.. S QUAL="",N=0
.. F S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N D
... S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
... S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
.. S QUAL=$$TKO^BQIUL1(QUAL,"; ")
.. S MEAS(TNAME)=VSDTM
.. S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TNAME_U_VALUE_U_QUAL_U_$J(BMI,3,2)_$C(30)
I BMI="" D
. NEW HT,WT,VSDTM,VISIT,VALUE,IEN
. S HT=$$MREC^BQIUTIL(DFN,9000010.01,"HT")
. S VISIT=$P(HT,U,4),VALUE=$P(HT,U,3),IEN=$P(HT,U,5),VSDTM=$P(HT,U,2)
. S QUAL="",N=0
. I HT F S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N D
.. S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
.. S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
. S QUAL=$$TKO^BQIUL1(QUAL,"; ")
. I VALUE="" S VALUE="None found"
. S MEAS("HEIGHT")=VSDTM
. S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_"HEIGHT"_U_VALUE_U_QUAL_U_"NC"_$C(30)
. S WT=$$MREC^BQIUTIL(DFN,9000010.01,"WT")
. S VISIT=$P(WT,U,4),VALUE=$P(WT,U,3),IEN=$P(WT,U,5),VSDTM=$P(WT,U,2)
. S QUAL="",N=0
. I WT F S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N D
.. S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
.. S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
. S QUAL=$$TKO^BQIUL1(QUAL,"; ")
. I VALUE="" S VALUE="None found"
. S MEAS("WEIGHT")=VSDTM
. S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_"WEIGHT"_U_VALUE_U_QUAL_U_"NC"_$C(30)
;
S VSDTM=$O(BQISORT(""),-1) I VSDTM="" G DONE
S VISIT=BQISORT(VSDTM)
;
S IEN="",BMI=""
F S IEN=$O(^AUPNVMSR("AD",VISIT,IEN)) Q:IEN="" D
. S TIEN=$$GET1^DIQ(9000010.01,IEN_",",.01,"I") I TIEN="" Q
. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
. S TNAME=$$GET1^DIQ(9999999.07,TIEN_",",.02,"E")
. I $G(MEAS(TNAME))'="" Q
. S VALUE=$$GET1^DIQ(9000010.01,IEN_",",.04,"E")
. S QUAL="",N=0
. F S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N D
.. S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
.. S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
. S QUAL=$$TKO^BQIUL1(QUAL,"; ")
. S BQIMEAS(TNAME)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TNAME_U_VALUE_U_QUAL_U_BMI
;
NEW MS
S MS=""
F S MS=$O(BQIMEAS(MS)) Q:MS="" D
. S II=II+1,@DATA@(II)=BQIMEAS(MS)_$C(30)
K MEAS,BQIMEAS
G DONE
BQIPTMSR ;PRXM/HC/ALA-Patient Measurements ; 23 Feb 2007 3:17 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
+3 QUIT
+4 ;
MSR(DATA,DFN,DRANGE) ; EP -- BQI PATIENT MEASUREMENTS
+1 ;
+2 ;Description - all the measurements that a patient has
+3 ;
+4 ;Input
+5 ; DFN - Patient internal entry number
+6 ; DRANGE - Date range as a relative date ie. T-6M
+7 ;
+8 NEW UID,II,IEN,TIEN,TNAME,VISIT,VSDTM,VALUE,OPROV,EPROV,PERCNT
+9 NEW BI,BMI,HDR,IENSMS,ORPHY,EVDTM,QN,N,QUAL
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("BQIPTMSR",UID))
+12 KILL @DATA
+13 ;
+14 SET II=0
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTMSR D UNWIND^%ZTER"
+16 ;
+17 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
+18 SET @DATA@(II)="I00010MEAS_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00030TYPE_DESC^T00100VALUE^D00030EVENT_DATETIME^N00005PERCENTILE^T01024QUALIF"_$CHAR(30)
+19 SET IEN=""
+20 FOR
SET IEN=$ORDER(^AUPNVMSR("AC",DFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+21 SET TIEN=$$GET1^DIQ(9000010.01,IEN_",",.01,"I")
IF TIEN=""
QUIT
+22 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+23 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+24 SET TNAME=$$GET1^DIQ(9999999.07,TIEN_",",.02,"E")
+25 SET VISIT=$$GET1^DIQ(9000010.01,IEN_",",.03,"I")
IF VISIT=""
QUIT
+26 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSDTM=0
QUIT
+27 IF DRANGE'=""
IF (VSDTM\1<DRANGE)
QUIT
+28 SET VALUE=$$GET1^DIQ(9000010.01,IEN_",",.04,"E")
+29 SET PERCNT=$$GET1^DIQ(9000010.01,IEN_",",.05,"E")
IF PERCNT=""
SET PERCNT=-1
+30 ;S OPROV=$$GET1^DIQ(9000010.01,IEN_",",1202,"E")
+31 ;S EPROV=$$GET1^DIQ(9000010.01,IEN_",",1204,"E")
+32 SET EVDTM=$$GET1^DIQ(9000010.01,IEN_",",1201,"I")
+33 SET QUAL=""
SET N=0
+34 FOR
SET N=$ORDER(^AUPNVMSR(IEN,5,N))
IF 'N
QUIT
Begin DoDot:2
+35 SET QN=$PIECE(^AUPNVMSR(IEN,5,N,0),U,1)
+36 SET QUAL=QUAL_$PIECE($GET(^GMRD(120.52,QN,0)),U,1)_"; "
End DoDot:2
+37 SET QUAL=$$TKO^BQIUL1(QUAL,"; ")
+38 SET II=II+1
SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TNAME_U_VALUE_U_$$FMTE^BQIUL1(EVDTM)_U_PERCNT_U_QUAL_$CHAR(30)
End DoDot:1
+39 ;
+40 ; Check for refusals
+41 DO REF
+42 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
REF ; Check for refusals
+1 NEW MSRN,RVDT,REVDT,RFIEN,VISIT,PERCNT,TNAME,VALUE
+2 SET MSRN=""
+3 FOR
SET MSRN=$ORDER(^AUPNPREF("AA",DFN,9999999.07,MSRN))
IF MSRN=""
QUIT
Begin DoDot:1
+4 SET RVDT=""
+5 FOR
SET RVDT=$ORDER(^AUPNPREF("AA",DFN,9999999.07,MSRN,RVDT))
IF RVDT=""
QUIT
Begin DoDot:2
+6 ; Reverse the reverse date
+7 SET REVDT=9999999-RVDT
+8 IF DRANGE'=""
IF (REVDT\1)<DRANGE
QUIT
+9 SET RFIEN=""
+10 FOR
SET RFIEN=$ORDER(^AUPNPREF("AA",DFN,9999999.07,MSRN,RVDT,RFIEN))
IF RFIEN=""
QUIT
Begin DoDot:3
+11 SET TNAME=$$GET1^DIQ(9999999.07,MSRN_",",.01,"E")
+12 SET VALUE=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
+13 SET ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
+14 SET PERCNT=-1
SET VISIT=""
SET EVDTM=""
+15 SET II=II+1
SET @DATA@(II)=U_VISIT_U_$$FMTE^BQIUL1(REVDT)_U_TNAME_U_VALUE_U_EVDTM_U_PERCNT_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
LST(DATA,DFN) ;EP -- BQI PATIENT LAST MEASURES
+1 ; Input
+2 ; DFN - Patient IEN
+3 NEW UID,II,IEN,QUAL,HDR,VISIT,VSDTM,BMI,IENS,BI,TIEN,TNAME,VALUE,BQISORT,MEAS,N
+4 NEW BMID,MSN,QFL
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("BQIPTMSR",UID))
+7 KILL @DATA
+8 ;
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTMSR D UNWIND^%ZTER"
+11 ;
+12 SET HDR="I00010MEAS_IEN^I00010VISIT_IEN^D00030EVENT_VISIT_DATETIME^T00030TYPE_DESC^T00100VALUE^T01024QUALIF^T00010BMI"
+13 SET @DATA@(II)=HDR_$CHAR(30)
+14 ;
+15 KILL BQISORT
+16 SET IEN=""
+17 FOR
SET IEN=$ORDER(^AUPNVMSR("AC",DFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+18 SET VISIT=$$GET1^DIQ(9000010.01,IEN_",",.03,"I")
IF VISIT=""
QUIT
+19 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDTM=0
QUIT
+20 SET BQISORT(VSDTM)=VISIT
End DoDot:1
+21 ;
+22 KILL MEAS
+23 ;S BMI=$$OBMI^BQITBMI(DFN,""),QUAL=""
+24 SET BMID=$$PBMI^APCLV(DFN,DT)
SET QUAL=""
+25 SET BMI=$PIECE(BMID,"^",1)
+26 IF BMI'=""
Begin DoDot:1
+27 FOR BI=4,7
SET VISIT=$PIECE(BMID,"^",BI)
Begin DoDot:2
+28 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+29 IF BI=4
SET TNAME="HEIGHT"
SET VALUE=$PIECE(BMID,"^",2)
+30 IF BI=7
SET TNAME="WEIGHT"
SET VALUE=$PIECE(BMID,"^",5)
+31 SET MSN=$$FIND1^DIC(9999999.07,,"MX",TNAME)
+32 SET IEN=$PIECE(BMID,"^",10)
+33 IF IEN=""
Begin DoDot:3
+34 SET MIEN=""
SET QFL=0
+35 FOR
SET MIEN=$ORDER(^AUPNVMSR("AD",VISIT,MIEN))
IF MIEN=""!(QFL)
QUIT
Begin DoDot:4
+36 IF $PIECE(^AUPNVMSR(MIEN,0),U,1)=MSN
SET IEN=MIEN
SET QFL=1
End DoDot:4
End DoDot:3
+37 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+38 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+39 SET QUAL=""
SET N=0
+40 FOR
SET N=$ORDER(^AUPNVMSR(IEN,5,N))
IF 'N
QUIT
Begin DoDot:3
+41 SET QN=$PIECE(^AUPNVMSR(IEN,5,N,0),U,1)
+42 SET QUAL=QUAL_$PIECE($GET(^GMRD(120.52,QN,0)),U,1)_"; "
End DoDot:3
+43 SET QUAL=$$TKO^BQIUL1(QUAL,"; ")
+44 SET MEAS(TNAME)=VSDTM
+45 SET II=II+1
SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TNAME_U_VALUE_U_QUAL_U_$JUSTIFY(BMI,3,2)_$CHAR(30)
End DoDot:2
End DoDot:1
+46 IF BMI=""
Begin DoDot:1
+47 NEW HT,WT,VSDTM,VISIT,VALUE,IEN
+48 SET HT=$$MREC^BQIUTIL(DFN,9000010.01,"HT")
+49 SET VISIT=$PIECE(HT,U,4)
SET VALUE=$PIECE(HT,U,3)
SET IEN=$PIECE(HT,U,5)
SET VSDTM=$PIECE(HT,U,2)
+50 SET QUAL=""
SET N=0
+51 IF HT
FOR
SET N=$ORDER(^AUPNVMSR(IEN,5,N))
IF 'N
QUIT
Begin DoDot:2
+52 SET QN=$PIECE(^AUPNVMSR(IEN,5,N,0),U,1)
+53 SET QUAL=QUAL_$PIECE($GET(^GMRD(120.52,QN,0)),U,1)_"; "
End DoDot:2
+54 SET QUAL=$$TKO^BQIUL1(QUAL,"; ")
+55 IF VALUE=""
SET VALUE="None found"
+56 SET MEAS("HEIGHT")=VSDTM
+57 SET II=II+1
SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_"HEIGHT"_U_VALUE_U_QUAL_U_"NC"_$CHAR(30)
+58 SET WT=$$MREC^BQIUTIL(DFN,9000010.01,"WT")
+59 SET VISIT=$PIECE(WT,U,4)
SET VALUE=$PIECE(WT,U,3)
SET IEN=$PIECE(WT,U,5)
SET VSDTM=$PIECE(WT,U,2)
+60 SET QUAL=""
SET N=0
+61 IF WT
FOR
SET N=$ORDER(^AUPNVMSR(IEN,5,N))
IF 'N
QUIT
Begin DoDot:2
+62 SET QN=$PIECE(^AUPNVMSR(IEN,5,N,0),U,1)
+63 SET QUAL=QUAL_$PIECE($GET(^GMRD(120.52,QN,0)),U,1)_"; "
End DoDot:2
+64 SET QUAL=$$TKO^BQIUL1(QUAL,"; ")
+65 IF VALUE=""
SET VALUE="None found"
+66 SET MEAS("WEIGHT")=VSDTM
+67 SET II=II+1
SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_"WEIGHT"_U_VALUE_U_QUAL_U_"NC"_$CHAR(30)
End DoDot:1
+68 ;
+69 SET VSDTM=$ORDER(BQISORT(""),-1)
IF VSDTM=""
GOTO DONE
+70 SET VISIT=BQISORT(VSDTM)
+71 ;
+72 SET IEN=""
SET BMI=""
+73 FOR
SET IEN=$ORDER(^AUPNVMSR("AD",VISIT,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+74 SET TIEN=$$GET1^DIQ(9000010.01,IEN_",",.01,"I")
IF TIEN=""
QUIT
+75 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+76 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+77 SET TNAME=$$GET1^DIQ(9999999.07,TIEN_",",.02,"E")
+78 IF $GET(MEAS(TNAME))'=""
QUIT
+79 SET VALUE=$$GET1^DIQ(9000010.01,IEN_",",.04,"E")
+80 SET QUAL=""
SET N=0
+81 FOR
SET N=$ORDER(^AUPNVMSR(IEN,5,N))
IF 'N
QUIT
Begin DoDot:2
+82 SET QN=$PIECE(^AUPNVMSR(IEN,5,N,0),U,1)
+83 SET QUAL=QUAL_$PIECE($GET(^GMRD(120.52,QN,0)),U,1)_"; "
End DoDot:2
+84 SET QUAL=$$TKO^BQIUL1(QUAL,"; ")
+85 SET BQIMEAS(TNAME)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TNAME_U_VALUE_U_QUAL_U_BMI
End DoDot:1
+86 ;
+87 NEW MS
+88 SET MS=""
+89 FOR
SET MS=$ORDER(BQIMEAS(MS))
IF MS=""
QUIT
Begin DoDot:1
+90 SET II=II+1
SET @DATA@(II)=BQIMEAS(MS)_$CHAR(30)
End DoDot:1
+91 KILL MEAS,BQIMEAS
+92 GOTO DONE
