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

BQITDLST.m

Go to the documentation of this file. 
  1. BQITDLST ;PRXM/HC/DB-Get History of a Tagged Patient ; 14 Nov 2007  4:38 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. GET(DATA,DFN,TAG) ; EP -- BQI GET DX CAT HISTORY
  1.  ; 
  1.  ; Input
  1.  ;  DFN - Patient internal entry number
  1.  ;
  1.  NEW UID,II,TIEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),II=0
  1.  S DATA=$NA(^TMP("BQITDLST",UID))
  1.  K @DATA
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITDLST D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S TAG=$G(TAG,"")
  1.  D HDR
  1.  I TAG="" D  G DONE
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(^BQIREG("AC",DFN,TIEN)) Q:TIEN=""  D TG(DFN,TIEN)
  1.  ;
  1.  I TAG'="" D
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(^BQIREG("C",DFN,TAG,TIEN)) Q:TIEN=""  D TG(DFN,TIEN)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GETDATA(DFN) ;EP - Retrieve patient data
  1.  NEW NAME,HRN,SEX,DOB,AGE,DOD
  1.  S NAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
  1.  S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
  1.  ;S SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
  1.  S SEX=$$GET1^DIQ(2,DFN_",",.02,"I")
  1.  S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN,.03,"I"))
  1.  S AGE=$$AGE^BQIAGE(DFN,,1)
  1.  S DOD=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.351,"I"))
  1.  Q DFN_U_NAME_U_HRN_U_DOB_U_AGE_U_SEX_U_DOD_U
  1.  ;
  1. HDR ;
  1.  S @DATA@(II)="I00010DFN^T00030PATIENT_NAME^T00030HRN^D00030DOB^T00010AGE^"
  1.  S @DATA@(II)=@DATA@(II)_"T00035TAG_NAME^I00010TAG_IEN^T00015STATUS^D00030DATE_LASTUPDATE^"
  1.  S @DATA@(II)=@DATA@(II)_"T00035UPDATED_BY^T00050COMMENT^T01024OTHER_COMMENT"_$C(30)
  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. TG(DFN,TIEN) ;EP - Get tag history data
  1.  NEW DEMOG,CDATA,HIEN,TAGNM,TAGIEN,STAT,TAGDTU,WHO,SCOM,OCOM,OCN
  1.  S DEMOG=$$GETDATA(DFN)
  1.  ; Get current tag data plus factors
  1.  D TAG^BQITDPNL(TIEN)
  1.  S CDATA=$P(@DATA@(II),U,1,12),CDATA=$$TKO^BQIUL1(CDATA,$C(30))
  1.  ; Get history data
  1.  S HIEN=0
  1.  F  S HIEN=$O(^BQIREG(TIEN,10,HIEN)) Q:'HIEN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=TIEN,DA=HIEN,IENS=$$IENS^DILF(.DA)
  1.  . S TAGNM=$$GET1^DIQ(90509,TIEN_",",.01,"E")
  1.  . S TAGIEN=$$GET1^DIQ(90509,TIEN_",",.01,"I")
  1.  . S STAT=$$GET1^DIQ(90509.01,IENS,.02,"I")
  1.  . S TAGDTU=$$GET1^DIQ(90509.01,IENS,.05,"I")
  1.  . S TAGDTU=$$FMTE^BQIUL1(TAGDTU)
  1.  . S WHO=$$GET1^DIQ(90509.01,IENS,.03,"E")
  1.  . S SCOM=$$GET1^DIQ(90509.01,IENS,.04,"I")
  1.  . S OCOM=""
  1.  . S OCN=0
  1.  . F  S OCN=$O(^BQIREG(TIEN,10,HIEN,1,OCN)) Q:'OCN  D
  1.  .. S OCOM=OCOM_^BQIREG(TIEN,10,HIEN,1,OCN,0)_$C(10)
  1.  . S II=II+1,@DATA@(II)=$P(DEMOG,U,1,5)_U_TAGNM_U_TAGIEN_U_STAT_U_TAGDTU_U_WHO_U_SCOM_U_OCOM_$C(30)
  1.  Q
  1.  ;
  1. DET(DATA,DFN,TAG) ; EP -- BQI GET DX CAT HIS DETAIL
  1.  ; 
  1.  ; Input
  1.  ;  DFN - Patient internal entry number
  1.  ;
  1.  NEW UID,II,TIEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),II=0
  1.  S DATA=$NA(^TMP("BQITDLST",UID))
  1.  K @DATA
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITDLST D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S TAG=$G(TAG,"")
  1.  D DHDR
  1.  I TAG="" D  G DDNE
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(^BQIREG("AC",DFN,TIEN)) Q:TIEN=""  D DTG(DFN,TIEN)
  1.  ;
  1.  I TAG'="" D
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(^BQIREG("C",DFN,TAG,TIEN)) Q:TIEN=""  D DTG(DFN,TIEN)
  1.  ;
  1. DDNE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DDATA(DFN) ;EP - Retrieve patient data
  1.  NEW NAME,HRN,SEX,DOB,AGE,DOD
  1.  S NAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
  1.  S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
  1.  ;S SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
  1.  S SEX=$$GET1^DIQ(2,DFN_",",.02,"I")
  1.  S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN,.03,"I"))
  1.  S AGE=$$AGE^BQIAGE(DFN,,1)
  1.  S DOD=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.351,"I"))
  1.  Q DFN_U_NAME_U_HRN_U_DOB_U_AGE_U_SEX_U_DOD_U
  1.  ;
  1. DHDR ;
  1.  S @DATA@(II)="I00010DFN^T00030PATIENT_NAME^T00030HRN^D00030DOB^T00010AGE^"
  1.  S @DATA@(II)=@DATA@(II)_"T00035TAG_NAME^I00010TAG_IEN^T00015STATUS^D00030DATE_LASTUPDATE^"
  1.  S @DATA@(II)=@DATA@(II)_"T00035UPDATED_BY^T00050COMMENT^T01024OTHER_COMMENT^T00060FACTOR^T00030PROBVISIT^"
  1.  S @DATA@(II)=@DATA@(II)_"T00030COMPLIANCE_VALUE^T00020PROB_VISIT_IEN^D00030VISIT_DATETIME"_$C(30)
  1.  Q
  1.  ;
  1. DTG(DFN,TIEN) ;EP - Get tag history data
  1.  NEW DEMOG,CDATA,FC,FACN,FPARMS,NN,HIEN,TAGNM,TAGIEN,STAT,TAGDTU,WHO,SCOM,OCOM,OCN
  1.  S DEMOG=$$DDATA(DFN)
  1.  ; Get current tag data plus factors
  1.  D TAG^BQITDPNL(TIEN)
  1.  S CDATA=$P(@DATA@(II),U,1,12),CDATA=$$TKO^BQIUL1(CDATA,$C(30))
  1.  I $O(^BQIREG(TIEN,5,0))'="" D
  1.  . S FC=0
  1.  . F  S FC=$O(^BQIREG(TIEN,5,FC)) Q:'FC  D
  1.  .. S FACN=$P(^BQIREG(TIEN,5,FC,0),U,1)
  1.  .. D FACD^BQIPTDX(FACN,.FPARMS)
  1.  .. S @DATA@(II)=CDATA_U_$G(FPARMS(1))_U_$G(FPARMS(2))_U_$G(FPARMS(3))_U_$G(FPARMS(4))_U_$G(FPARMS(5))_$C(30)
  1.  .. I $O(^BQIREG(TIEN,5,FC))'="B" S II=II+1
  1.  D FPD^BQIPTDX(DFN,$P(^BQIREG(TIEN,0),U,1),.FPARMS)
  1.  S NN=""
  1.  F  S NN=$O(FPARMS(NN)) Q:NN=""  D
  1.  . S @DATA@(II)=CDATA_U_$G(FPARMS(NN,1))_U_$G(FPARMS(NN,2))_U_$G(FPARMS(NN,3))_U_$G(FPARMS(NN,4))_U_$G(FPARMS(NN,5))_$C(30)
  1.  . I $O(FPARMS(NN))'="" S II=II+1
  1.  K FPARMS
  1.  ; Get history data
  1.  S HIEN=0
  1.  F  S HIEN=$O(^BQIREG(TIEN,10,HIEN)) Q:'HIEN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=TIEN,DA=HIEN,IENS=$$IENS^DILF(.DA)
  1.  . S TAGNM=$$GET1^DIQ(90509,TIEN_",",.01,"E")
  1.  . S TAGIEN=$$GET1^DIQ(90509,TIEN_",",.01,"I")
  1.  . S STAT=$$GET1^DIQ(90509.01,IENS,.02,"I")
  1.  . S TAGDTU=$$GET1^DIQ(90509.01,IENS,.05,"I")
  1.  . S TAGDTU=$$FMTE^BQIUL1(TAGDTU)
  1.  . S WHO=$$GET1^DIQ(90509.01,IENS,.03,"E")
  1.  . S SCOM=$$GET1^DIQ(90509.01,IENS,.04,"I")
  1.  . S OCOM=""
  1.  . S OCN=0
  1.  . F  S OCN=$O(^BQIREG(TIEN,10,HIEN,1,OCN)) Q:'OCN  D
  1.  .. S OCOM=OCOM_^BQIREG(TIEN,10,HIEN,1,OCN,0)_$C(10)
  1.  . S FC=0
  1.  . I $O(^BQIREG(TIEN,10,HIEN,5,FC))'="" D  Q
  1.  .. F  S FC=$O(^BQIREG(TIEN,10,HIEN,5,FC)) Q:'FC  D
  1.  ... S FACN=$P(^BQIREG(TIEN,10,HIEN,5,FC,0),U,1)
  1.  ... D FACD^BQIPTDX(FACN,.FPARMS)
  1.  ... S II=II+1,@DATA@(II)=$P(DEMOG,U,1,5)_U_TAGNM_U_TAGIEN_U_STAT_U_TAGDTU_U_WHO_U_SCOM_U_OCOM_U
  1.  ... S @DATA@(II)=@DATA@(II)_$G(FPARMS(1))_U_$G(FPARMS(2))_U_$G(FPARMS(3))_U_$G(FPARMS(4))_U_$G(FPARMS(5))_$C(30)
  1.  . S II=II+1,@DATA@(II)=$P(DEMOG,U,1,5)_U_TAGNM_U_TAGIEN_U_STAT_U_TAGDTU_U_WHO_U_SCOM_U_OCOM_U
  1.  . S @DATA@(II)=@DATA@(II)_$G(FPARMS(1))_U_$G(FPARMS(2))_U_$G(FPARMS(3))_U_$G(FPARMS(4))_U_$G(FPARMS(5))_$C(30)
  1.  K FPARMS
  1.  Q