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

BQITIULS.m

Go to the documentation of this file. 
  1. BQITIULS ;VNGT/HS/ALA-Build List of Documents for a Patient ; 30 Jan 2009  12:50 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1. LST(DATA,DFN,TMFRAME) ; EP -- BQI GET DOC LIST BY PAT
  1.  ; Input Variables
  1.  ;   DFN     - Patient Internal entry Number
  1.  ;   TMFRAME - Date time frame (a set of values e.g. 3 months = T-3M)
  1.  ;
  1.  NEW UID,II,HDR,AUTHOR,CLASS,IXDT,STATUS,TITLE,TIUDA,TITN,SUBJ,SRTCT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQITIULS",UID))
  1.  K @DATA
  1.  K ^TMP("BQITIULS_1",$J)
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITIULS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00060CLASS^T00060TITLE^T00080SUBJECT^D00030DATETIME^T00030STATUS^T00035AUTHOR^I00010TIUDA"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  S TMFRAME=$$DATE^BQIUL1($G(TMFRAME))
  1.  I TMFRAME'="" S BDT=(9999999-DT)-.001,EDT=(9999999-TMFRAME)
  1.  I TMFRAME="" S BDT="",EDT=""
  1.  ;
  1.  I BDT="",EDT="" D  G SORT
  1.  . S TIUDA=""
  1.  . F  S TIUDA=$O(^TIU(8925,"C",DFN,TIUDA)) Q:TIUDA=""  D REC(TIUDA)
  1.  ;
  1.  F  S BDT=$O(^TIU(8925,"AE",DFN,BDT)) Q:BDT=""!(BDT>EDT)  D
  1.  . S TITN=""
  1.  . F  S TITN=$O(^TIU(8925,"AE",DFN,BDT,TITN)) Q:TITN=""  D
  1.  .. S TIUDA=""
  1.  .. F  S TIUDA=$O(^TIU(8925,"AE",DFN,BDT,TITN,TIUDA)) Q:TIUDA=""  D REC(TIUDA)
  1.  ;
  1. SORT ;
  1.  S IXDT="" F  S IXDT=$O(^TMP("BQITIULS_1",$J,IXDT),-1) Q:IXDT=""  S SRTCT="" F  S SRTCT=$O(^TMP("BQITIULS_1",$J,IXDT,SRTCT)) Q:SRTCT=""  S II=II+1,@DATA@(II)=$G(^TMP("BQITIULS_1",$J,IXDT,SRTCT))
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  K ^TMP("BQITIULS_1",$J)
  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. REC(TIUDA) ;
  1.  ;
  1.  NEW TDTNTD,TDTCRT
  1.  ;
  1.  ;Pull CLASS - Do not return ADDENDUM records
  1.  S CLASS=$$GET1^DIQ(8925,TIUDA_",",.04,"E")
  1.  Q:CLASS="ADDENDUM"
  1.  ;
  1.  S TITLE=$$GET1^DIQ(8925,TIUDA_",",.01,"I")
  1.  S:TITLE]"" TITLE=$P($G(^TIU(8925.1,TITLE,0)),U)
  1.  Q:TITLE=""  ;Skip corrupted entries
  1.  ;
  1.  S AUTHOR=$$GET1^DIQ(8925,TIUDA_",",1202,"E")
  1.  ;
  1.  S TDTCRT=$$GET1^DIQ(8925,TIUDA_",",1201,"I")
  1.  S (TDTNTD,IXDT)=$$GET1^DIQ(8925,TIUDA_",",1301,"I")
  1.  I IXDT="" S IXDT=$S(TDTCRT]"":TDTCRT,1:"~")
  1.  ;
  1.  S STATUS=$$GET1^DIQ(8925,TIUDA_",",.05,"E")
  1.  I STATUS'="COMPLETED" Q
  1.  S SUBJ=$$GET1^DIQ(8925,TIUDA_",",1701,"E")
  1.  ;
  1.  S SRTCT=$G(SRTCT)+1
  1.  S ^TMP("BQITIULS_1",$J,IXDT,SRTCT)=CLASS_U_TITLE_U_SUBJ_U_$$FMTE^BQIUL1(TDTNTD)_U_STATUS_U_AUTHOR_U_TIUDA_$C(30)
  1.  Q
  1.  ;
  1. CNT(DATA,DFN) ; EP -- BQI DOC COUNT BY PAT
  1.  ; Input Variables
  1.  ;   DFN   - Patient Internal entry Number
  1.  ;
  1.  NEW UID,II,HDR,TIUDA,TDTCRT,ARRAY,CT,EDT,BDT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQITIUCT",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITIULS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="D00015FROM_DATE^D00015THRU_DATE^I00010NUM"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  ;
  1.  K ARRAY
  1.  S TIUDA="",CT=0
  1.  F  S TIUDA=$O(^TIU(8925,"C",DFN,TIUDA)) Q:TIUDA=""  D
  1.  . S TDTCRT=$$GET1^DIQ(8925,TIUDA_",",1201,"I")\1
  1.  . I TDTCRT=0 Q
  1.  . S ARRAY(TDTCRT)="",CT=CT+1
  1.  S BDT=$O(ARRAY("")),EDT=$O(ARRAY(""),-1)
  1.  I CT>0 S II=II+1,@DATA@(II)=$$FMTE^BQIUL1(BDT)_U_$$FMTE^BQIUL1(EDT)_U_CT_$C(30)
  1.  G DONE