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

BQIPTDX.m

Go to the documentation of this file. 
  1. BQIPTDX ;PRXM/HC/ALA-Patient Diagnosis Categories ; 18 May 2006  10:14 AM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. GET(DATA,DFN) ; EP -- BQI PAT DX CAT
  1.  ;
  1.  ;Description
  1.  ;  Returns a list of all of the Diagnosis Categories for a patient
  1.  ;Input
  1.  ;   DFN  - Patient internal entry number
  1.  ;
  1.  NEW UID,II,DTMU,DXN,FN,NAME,FNAME,REC,CT,RECORD,RDATE,TAGDTU,WHO,COM
  1.  NEW RTYP,X,DXC,BNAME,COMPIEN,COMPREF,COMPVAL,FTNAME,TSTAT,SIEN,SCOM
  1.  NEW OCN,RIEN,BQVAL,OCOM,FREF,IEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTDX",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTDX D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  ;
  1.  S DXN=""
  1.  F  S DXN=$O(^BQIREG("C",DFN,DXN)) Q:DXN=""  D
  1.  . S NAME=$$GET1^DIQ(90506.2,DXN_",",.01,"E")
  1.  . S SIEN=$O(^BQIREG("C",DFN,DXN,"")) I SIEN="" Q
  1.  . S TAGDTU=$P(^BQIREG(SIEN,0),U,4)
  1.  . S TAGDTU=$$FMTE^BQIUL1(TAGDTU)
  1.  . S WHO=$P(^BQIREG(SIEN,0),U,5)
  1.  . S TSTAT=$P(^BQIREG(SIEN,0),U,3)
  1.  . S SCOM=$$GET1^DIQ(90509,SIEN_",",.06,"I")
  1.  . S OCOM=""
  1.  . S OCN=0
  1.  . F  S OCN=$O(^BQIREG(SIEN,1,OCN)) Q:'OCN  D
  1.  .. S OCOM=OCOM_^BQIREG(SIEN,1,OCN,0)_" "
  1.  . ;
  1.  . S RIEN=""
  1.  . F  S RIEN=$O(^BQIREG("C",DFN,DXN,RIEN)) Q:RIEN=""  D
  1.  .. ;D RDATA(.DXN,.RIEN)
  1.  .. S BQVAL=$$RDATA(DXN,RIEN)
  1.  .. ;I $O(^BQIPAT(DFN,20,DXN,0))'="" D GDATA(.DXN)
  1.  .. I 'BQVAL S BQVAL=$$GDATA(DXN)
  1.  .. I 'BQVAL D
  1.  ... S II=II+1
  1.  ... S @DATA@(II)=DXN_U_U_U_U_U_U_U_TSTAT_U
  1.  ... S @DATA@(II)=@DATA@(II)_TAGDTU_U_WHO_U_SCOM_U_OCOM_$C(30)
  1.  ;
  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. GDATA(DXN) ;EP - Get patient's data by diagnosis category
  1.  NEW BQRES,LII,STAT
  1.  S FN=0,BQRES=0
  1.  F  S FN=$O(^BQIPAT(DFN,20,DXN,1,FN)) Q:'FN  D
  1.  . S DTMU=$P(^BQIPAT(DFN,20,DXN,0),U,2)
  1.  . S FNAME=$P(^BQIPAT(DFN,20,DXN,1,FN,0),U,1)
  1.  . S SIEN=$O(^BQIREG("C",DFN,DXN,"")) I SIEN="" Q
  1.  . S STAT=$P(^BQIREG(SIEN,0),U,3)
  1.  . I STAT'="A",STAT'="P" Q
  1.  . ;
  1.  . ; If the met criteria is a tag, get the original data to display
  1.  . I FNAME[" Tag" S FTNAME=FNAME D TGG Q
  1.  . ;
  1.  . S REC="A",CT=0
  1.  . I '$O(^BQIPAT(DFN,20,DXN,1,FN,1,REC),-1) D
  1.  .. S II=II+1
  1.  .. S @DATA@(II)=DXN_"^"_$$FMTE^BQIUL1(DTMU)_"^"_FNAME_"^^"_$C(30)
  1.  . F  S REC=$O(^BQIPAT(DFN,20,DXN,1,FN,1,REC),-1) Q:'REC!(CT>3)  D
  1.  .. S CT=CT+1 Q:CT>3
  1.  .. ;
  1.  .. S COMPVAL=""
  1.  .. S RECORD=$P(^BQIPAT(DFN,20,DXN,1,FN,1,REC,0),U,1),RDATE=$P(^(0),U,2)
  1.  .. S COMPIEN=$P(^BQIPAT(DFN,20,DXN,1,FN,1,REC,0),U,4)
  1.  .. S FREF=$P(^BQIPAT(DFN,20,DXN,1,FN,1,REC,0),U,5)
  1.  .. I FREF'="" D
  1.  ... S COMPREF=$P(^DD(FREF,.01,0),U,1)
  1.  ... S COMPVAL=COMPREF_": "_$$GET1^DIQ(FREF,COMPIEN_",",.01,"E")
  1.  .. I $E(RECORD,1,1)="P" S COMPVAL="Problem: "_$$GET1^DIQ(9000011,$E(RECORD,2,$L(RECORD))_",",.01,"E")
  1.  .. S RTYP=$S($E(RECORD,1,1)="P":"Problem",1:"Visit")
  1.  .. I RDATE="" D
  1.  ... NEW IEN
  1.  ... S IEN=$E(RECORD,2,$L(RECORD))
  1.  ... I $E(RTYP,1,1)="P" S RDATE=$$PROB^BQIUL1(IEN)
  1.  ... I $E(RTYP,1,1)="V" S RDATE=$$GET1^DIQ(9000010,IEN_",",.01,"I")
  1.  .. S II=II+1,BQRES=1
  1.  .. S @DATA@(II)=DXN_U_$$FMTE^BQIUL1(DTMU)_U_FNAME_U_RTYP_U_COMPVAL_U_RECORD_U_$$FMTE^BQIUL1(RDATE)_U
  1.  .. S @DATA@(II)=@DATA@(II)_STAT_U_TAGDTU_U_WHO_U_SCOM_U_OCOM_$C(30)
  1.  Q BQRES
  1.  ;
  1. RDATA(DXN,BRIEN) ;EP
  1.  NEW BQRES,STAT
  1.  S BQRES=0
  1.  S STAT=$P(^BQIREG(BRIEN,0),U,3)
  1.  I STAT="P" D  Q BQRES
  1.  . S FN=0
  1.  . F  S FN=$O(^BQIREG(BRIEN,5,FN)) Q:'FN  D
  1.  .. D FAC(FN,.BQRES)
  1.  ;
  1.  S IEN=""
  1.  F  S IEN=$O(^BQIFACT("C",DFN,DXN,IEN)) Q:IEN=""  D FAC(IEN,.BQRES)
  1.  Q BQRES
  1.  ;
  1. TGG ; If the met criteria is a tag, get the original data to display
  1.  NEW FNAME,DXNN,RIEN
  1.  I FTNAME["-" S FTNAME=$P(FTNAME,"-",2)
  1.  S FTNAME=$P(FTNAME," Tag",1)
  1.  S DXNN=$$GDXN^BQITUTL(FTNAME),LII=II,BNAME=NAME
  1.  S RIEN=""
  1.  F  S RIEN=$O(^BQIREG("C",DFN,DXNN,RIEN)) Q:RIEN=""  D
  1.  . D RDATA(.DXNN,.RIEN)
  1.  . I $O(^BQIPAT(DFN,20,DXNN,0))'="" D GDATA(.DXNN)
  1.  ;I $D(^BQIPAT(DFN,20,DXNN)) D GDATA(DXNN)
  1.  ;I $D(^BQIREG("C",DFN,DXNN)) D RDATA(DXNN)
  1.  F  S LII=$O(@DATA@(LII)) Q:LII=""  S $P(@DATA@(LII),U,1)=DXN
  1.  Q
  1.  ;
  1. HDR ; Set up header
  1.  S @DATA@(II)="I00010DIAG_CAT_IEN^D00030CAT_LAST_UPDATED^T00060FACTOR^T00030PROBVISIT^T00030COMPLIANCE_VALUE^"
  1.  S @DATA@(II)=@DATA@(II)_"T00020PROB_VISIT_IEN^D00030VISIT_DATETIME^T00015STATUS^D00030STATUS_LASTUPDATE^"
  1.  S @DATA@(II)=@DATA@(II)_"T00035UPDATED_BY^T00050COMMENT^T01024OTHER_COMMENT"_$C(30)
  1.  Q
  1.  ;
  1. FAC(FIEN,BQRES) ; EP - Get factor data
  1.  NEW FDATA,FNAME,DTMU,COMPVAL,RDATE,COMPIEN,FREF,RECORD,COMPREF,COMPVAL
  1.  NEW COMPIEN,RTYP,RECORD
  1.  S FDATA=^BQIFACT(FIEN,0)
  1.  S FNAME=$P(FDATA,U,1)
  1.  ;I FNAME[" Tag" S FTNAME=FNAME D TGG Q
  1.  I FNAME["Age:" S RTYP=""
  1.  ;
  1.  ;S DTMU=$P(FDATA,U,4)\1
  1.  S DTMU=$P(FDATA,U,4)
  1.  S COMPVAL=""
  1.  S RDATE=$P(FDATA,U,6)
  1.  S COMPIEN=$P(FDATA,U,5),FREF=$P(FDATA,U,8),RECORD=$P(FDATA,U,7)
  1.  I FREF'="" D
  1.  . S COMPREF=$P(^DD(FREF,.01,0),U,1)
  1.  . S COMPVAL=COMPREF_": "_$$GET1^DIQ(FREF,RECORD_",",.01,"E")
  1.  I $P(COMPIEN,";",2)="AUPNPROB(" S COMPVAL="Problem: "_$$GET1^DIQ(9000011,$P(COMPIEN,";",1)_",",.01,"E"),RTYP="Problem"
  1.  I $P(COMPIEN,";",2)="AUPNVSIT(" S RTYP="Visit"
  1.  ;
  1.  I RDATE="" D
  1.  . NEW IEN
  1.  . S IEN=$P(COMPIEN,";",1)
  1.  . I $E(RTYP,1,1)="P" S RDATE=$$PROB^BQIUL1(IEN)
  1.  . I $E(RTYP,1,1)="V" S RDATE=$$GET1^DIQ(9000010,IEN_",",.01,"I")
  1.  S RECORD=$E(RTYP,1,1)_$P(COMPIEN,";",1)
  1.  S II=II+1
  1.  S @DATA@(II)=DXN_U_$$FMTE^BQIUL1(DTMU)_U_FNAME_U_RTYP_U_COMPVAL_U_RECORD_U_$$FMTE^BQIUL1(RDATE)_U_STAT_U
  1.  S @DATA@(II)=@DATA@(II)_TAGDTU_U_WHO_U_SCOM_U_OCOM_$C(30)
  1.  S BQRES=1
  1.  Q
  1.  ;
  1. FACD(FIEN,FPARMS) ;EP - Get factor data
  1.  K FPARMS
  1.  NEW FNAME,RTYP,FDATA,DTMU,COMPVAL,RDATE,COMPIEN,FREF,RECORD,COMPVAL
  1.  NEW COMPREF
  1.  S FDATA=^BQIFACT(FIEN,0)
  1.  S FNAME=$P(FDATA,U,1)
  1.  I FNAME["Age:" S RTYP=""
  1.  ;
  1.  ;S DTMU=$P(FDATA,U,4)\1
  1.  S DTMU=$P(FDATA,U,4)
  1.  S COMPVAL=""
  1.  S RDATE=$P(FDATA,U,6)
  1.  S COMPIEN=$P(FDATA,U,5),FREF=$P(FDATA,U,8),RECORD=$P(FDATA,U,7)
  1.  I FREF'="" D
  1.  . S COMPREF=$P(^DD(FREF,.01,0),U,1)
  1.  . S COMPVAL=COMPREF_": "_$$GET1^DIQ(FREF,RECORD_",",.01,"E")
  1.  I $P(COMPIEN,";",2)="AUPNPROB(" S COMPVAL="Problem: "_$$GET1^DIQ(9000011,$P(COMPIEN,";",1)_",",.01,"E"),RTYP="Problem"
  1.  I $P(COMPIEN,";",2)="AUPNVSIT(" S RTYP="Visit"
  1.  ;
  1.  I RDATE="" D
  1.  . NEW IEN
  1.  . S IEN=$P(COMPIEN,";",1)
  1.  . I $E(RTYP,1,1)="P" S RDATE=$$PROB^BQIUL1(IEN)
  1.  . I $E(RTYP,1,1)="V" S RDATE=$$GET1^DIQ(9000010,IEN_",",.01,"I")
  1.  S RECORD=$E(RTYP,1,1)_$P(COMPIEN,";",1)
  1.  S FPARMS(1)=FNAME,FPARMS(2)=RTYP,FPARMS(3)=COMPVAL,FPARMS(4)=RECORD,FPARMS(5)=$$FMTE^BQIUL1(RDATE)
  1.  Q
  1.  ;
  1. FPD(BQIDFN,BQITAG,FPARMS) ;EP - Get proposed factor data
  1.  K FPARMS
  1.  NEW BQIFN,BQIFAC,BQIRN,BQIREC,BQIRDT,BQIREX,BQIIEN,COMPVAL,RTYP,BQIFIL
  1.  NEW COMPREF,BQIVPR
  1.  S BQIFN=0
  1.  F  S BQIFN=$O(^BQIPAT(BQIDFN,20,BQITAG,1,BQIFN)) Q:'BQIFN  D
  1.  . S BQIFAC=$P(^BQIPAT(BQIDFN,20,BQITAG,1,BQIFN,0),U,1)
  1.  . I BQIFAC["Age:" S BQIVPR=""
  1.  . S BQIRN=0
  1.  . F  S BQIRN=$O(^BQIPAT(BQIDFN,20,BQITAG,1,BQIFN,1,BQIRN)) Q:'BQIRN  D
  1.  .. S BQIREC=$P(^BQIPAT(BQIDFN,20,BQITAG,1,BQIFN,1,BQIRN,0),U,1)
  1.  .. S BQIRDT=$P(^BQIPAT(BQIDFN,20,BQITAG,1,BQIFN,1,BQIRN,0),U,2)
  1.  .. S BQIREX=$P(^BQIPAT(BQIDFN,20,BQITAG,1,BQIFN,1,BQIRN,0),U,3)
  1.  .. S BQIIEN=$P(^BQIPAT(BQIDFN,20,BQITAG,1,BQIFN,1,BQIRN,0),U,4)
  1.  .. S BQIFIL=$P(^BQIPAT(BQIDFN,20,BQITAG,1,BQIFN,1,BQIRN,0),U,5)
  1.  .. S COMPVAL=""
  1.  .. S RTYP=$S($E(BQIREC,1,1)="V":"Visit",1:"Problem")
  1.  .. S COMPVAL="Problem: "_$$GET1^DIQ(9000011,$E(BQIREC,2,$L(BQIREC))_",",.01,"E")
  1.  .. I BQIFIL'="" D
  1.  ... S COMPREF=$P(^DD(BQIFIL,.01,0),U,1)
  1.  ... S COMPVAL=COMPREF_": "_$$GET1^DIQ(BQIFIL,BQIIEN_",",.01,"E")
  1.  .. S FPARMS(BQIFN_BQIRN,1)=BQIFAC,FPARMS(BQIFN_BQIRN,2)=RTYP,FPARMS(BQIFN_BQIRN,3)=COMPVAL
  1.  .. S FPARMS(BQIFN_BQIRN,4)=BQIREC,FPARMS(BQIFN_BQIRN,5)=$$FMTE^BQIUL1(BQIRDT)
  1.  Q