Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIPTMSR

BQIPTMSR.m

Go to the documentation of this file. 
  1. BQIPTMSR ;PRXM/HC/ALA-Patient Measurements ; 23 Feb 2007  3:17 PM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
  1.  ;
  1.  Q
  1.  ;
  1. MSR(DATA,DFN,DRANGE) ; EP -- BQI PATIENT MEASUREMENTS
  1.  ;
  1.  ;Description - all the measurements that a patient has
  1.  ;
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;  DRANGE - Date range as a relative date ie. T-6M
  1.  ;
  1.  NEW UID,II,IEN,TIEN,TNAME,VISIT,VSDTM,VALUE,OPROV,EPROV,PERCNT
  1.  NEW BI,BMI,HDR,IENSMS,ORPHY,EVDTM,QN,N,QUAL
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTMSR",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTMSR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S DRANGE=$$DATE^BQIUL1($G(DRANGE))
  1.  S @DATA@(II)="I00010MEAS_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00030TYPE_DESC^T00100VALUE^D00030EVENT_DATETIME^N00005PERCENTILE^T01024QUALIF"_$C(30)
  1.  S IEN=""
  1.  F  S IEN=$O(^AUPNVMSR("AC",DFN,IEN),-1) Q:IEN=""  D
  1.  . S TIEN=$$GET1^DIQ(9000010.01,IEN_",",.01,"I") I TIEN="" Q
  1.  . ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
  1.  . I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
  1.  . S TNAME=$$GET1^DIQ(9999999.07,TIEN_",",.02,"E")
  1.  . S VISIT=$$GET1^DIQ(9000010.01,IEN_",",.03,"I") I VISIT="" Q
  1.  . S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSDTM=0 Q
  1.  . I DRANGE'="",(VSDTM\1<DRANGE) Q
  1.  . S VALUE=$$GET1^DIQ(9000010.01,IEN_",",.04,"E")
  1.  . S PERCNT=$$GET1^DIQ(9000010.01,IEN_",",.05,"E") S:PERCNT="" PERCNT=-1
  1.  . ;S OPROV=$$GET1^DIQ(9000010.01,IEN_",",1202,"E")
  1.  . ;S EPROV=$$GET1^DIQ(9000010.01,IEN_",",1204,"E")
  1.  . S EVDTM=$$GET1^DIQ(9000010.01,IEN_",",1201,"I")
  1.  . S QUAL="",N=0
  1.  . F  S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N  D
  1.  .. S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
  1.  .. S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
  1.  . S QUAL=$$TKO^BQIUL1(QUAL,"; ")
  1.  . 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)
  1.  ;
  1.  ; Check for refusals
  1.  D REF
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. REF ; Check for refusals
  1.  NEW MSRN,RVDT,REVDT,RFIEN,VISIT,PERCNT,TNAME,VALUE
  1.  S MSRN=""
  1.  F  S MSRN=$O(^AUPNPREF("AA",DFN,9999999.07,MSRN)) Q:MSRN=""  D
  1.  . S RVDT=""
  1.  . F  S RVDT=$O(^AUPNPREF("AA",DFN,9999999.07,MSRN,RVDT)) Q:RVDT=""  D
  1.  .. ; Reverse the reverse date
  1.  .. S REVDT=9999999-RVDT
  1.  .. I DRANGE'="",(REVDT\1)<DRANGE Q
  1.  .. S RFIEN=""
  1.  .. F  S RFIEN=$O(^AUPNPREF("AA",DFN,9999999.07,MSRN,RVDT,RFIEN)) Q:RFIEN=""  D
  1.  ... S TNAME=$$GET1^DIQ(9999999.07,MSRN_",",.01,"E")
  1.  ... S VALUE=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
  1.  ... S ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
  1.  ... S PERCNT=-1,VISIT="",EVDTM=""
  1.  ... S II=II+1,@DATA@(II)=U_VISIT_U_$$FMTE^BQIUL1(REVDT)_U_TNAME_U_VALUE_U_EVDTM_U_PERCNT_$C(30)
  1.  Q
  1.  ;
  1. LST(DATA,DFN) ;EP -- BQI PATIENT LAST MEASURES
  1.  ; Input
  1.  ;   DFN - Patient IEN
  1.  NEW UID,II,IEN,QUAL,HDR,VISIT,VSDTM,BMI,IENS,BI,TIEN,TNAME,VALUE,BQISORT,MEAS,N
  1.  NEW BMID,MSN,QFL
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTMSR",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTMSR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="I00010MEAS_IEN^I00010VISIT_IEN^D00030EVENT_VISIT_DATETIME^T00030TYPE_DESC^T00100VALUE^T01024QUALIF^T00010BMI"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  K BQISORT
  1.  S IEN=""
  1.  F  S IEN=$O(^AUPNVMSR("AC",DFN,IEN),-1) Q:IEN=""  D
  1.  . S VISIT=$$GET1^DIQ(9000010.01,IEN_",",.03,"I") I VISIT="" Q
  1.  . S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSDTM=0 Q
  1.  . S BQISORT(VSDTM)=VISIT
  1.  ;
  1.  K MEAS
  1.  ;S BMI=$$OBMI^BQITBMI(DFN,""),QUAL=""
  1.  S BMID=$$PBMI^APCLV(DFN,DT),QUAL=""
  1.  S BMI=$P(BMID,"^",1)
  1.  I BMI'="" D
  1.  . F BI=4,7 S VISIT=$P(BMID,"^",BI) D
  1.  .. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
  1.  .. I BI=4 S TNAME="HEIGHT",VALUE=$P(BMID,"^",2)
  1.  .. I BI=7 S TNAME="WEIGHT",VALUE=$P(BMID,"^",5)
  1.  .. S MSN=$$FIND1^DIC(9999999.07,,"MX",TNAME)
  1.  .. S IEN=$P(BMID,"^",10)
  1.  .. I IEN="" D
  1.  ... S MIEN="",QFL=0
  1.  ... F  S MIEN=$O(^AUPNVMSR("AD",VISIT,MIEN)) Q:MIEN=""!(QFL)  D
  1.  .... I $P(^AUPNVMSR(MIEN,0),U,1)=MSN S IEN=MIEN,QFL=1
  1.  .. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
  1.  .. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
  1.  .. S QUAL="",N=0
  1.  .. F  S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N  D
  1.  ... S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
  1.  ... S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
  1.  .. S QUAL=$$TKO^BQIUL1(QUAL,"; ")
  1.  .. S MEAS(TNAME)=VSDTM
  1.  .. 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)
  1.  I BMI="" D
  1.  . NEW HT,WT,VSDTM,VISIT,VALUE,IEN
  1.  . S HT=$$MREC^BQIUTIL(DFN,9000010.01,"HT")
  1.  . S VISIT=$P(HT,U,4),VALUE=$P(HT,U,3),IEN=$P(HT,U,5),VSDTM=$P(HT,U,2)
  1.  . S QUAL="",N=0
  1.  . I HT F  S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N  D
  1.  .. S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
  1.  .. S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
  1.  . S QUAL=$$TKO^BQIUL1(QUAL,"; ")
  1.  . I VALUE="" S VALUE="None found"
  1.  . S MEAS("HEIGHT")=VSDTM
  1.  . S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_"HEIGHT"_U_VALUE_U_QUAL_U_"NC"_$C(30)
  1.  . S WT=$$MREC^BQIUTIL(DFN,9000010.01,"WT")
  1.  . S VISIT=$P(WT,U,4),VALUE=$P(WT,U,3),IEN=$P(WT,U,5),VSDTM=$P(WT,U,2)
  1.  . S QUAL="",N=0
  1.  . I WT F  S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N  D
  1.  .. S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
  1.  .. S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
  1.  . S QUAL=$$TKO^BQIUL1(QUAL,"; ")
  1.  . I VALUE="" S VALUE="None found"
  1.  . S MEAS("WEIGHT")=VSDTM
  1.  . S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_"WEIGHT"_U_VALUE_U_QUAL_U_"NC"_$C(30)
  1.  ;
  1.  S VSDTM=$O(BQISORT(""),-1) I VSDTM="" G DONE
  1.  S VISIT=BQISORT(VSDTM)
  1.  ;
  1.  S IEN="",BMI=""
  1.  F  S IEN=$O(^AUPNVMSR("AD",VISIT,IEN)) Q:IEN=""  D
  1.  . S TIEN=$$GET1^DIQ(9000010.01,IEN_",",.01,"I") I TIEN="" Q
  1.  . ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
  1.  . I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
  1.  . S TNAME=$$GET1^DIQ(9999999.07,TIEN_",",.02,"E")
  1.  . I $G(MEAS(TNAME))'="" Q
  1.  . S VALUE=$$GET1^DIQ(9000010.01,IEN_",",.04,"E")
  1.  . S QUAL="",N=0
  1.  . F  S N=$O(^AUPNVMSR(IEN,5,N)) Q:'N  D
  1.  .. S QN=$P(^AUPNVMSR(IEN,5,N,0),U,1)
  1.  .. S QUAL=QUAL_$P($G(^GMRD(120.52,QN,0)),U,1)_"; "
  1.  . S QUAL=$$TKO^BQIUL1(QUAL,"; ")
  1.  . S BQIMEAS(TNAME)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_TNAME_U_VALUE_U_QUAL_U_BMI
  1.  ;
  1.  NEW MS
  1.  S MS=""
  1.  F  S MS=$O(BQIMEAS(MS)) Q:MS=""  D
  1.  . S II=II+1,@DATA@(II)=BQIMEAS(MS)_$C(30)
  1.  K MEAS,BQIMEAS
  1.  G DONE