BQITIULS ;VNGT/HS/ALA-Build List of Documents for a Patient ; 30 Jan 2009 12:50 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
LST(DATA,DFN,TMFRAME) ; EP -- BQI GET DOC LIST BY PAT
; Input Variables
; DFN - Patient Internal entry Number
; TMFRAME - Date time frame (a set of values e.g. 3 months = T-3M)
;
NEW UID,II,HDR,AUTHOR,CLASS,IXDT,STATUS,TITLE,TIUDA,TITN,SUBJ,SRTCT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITIULS",UID))
K @DATA
K ^TMP("BQITIULS_1",$J)
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITIULS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00060CLASS^T00060TITLE^T00080SUBJECT^D00030DATETIME^T00030STATUS^T00035AUTHOR^I00010TIUDA"
S @DATA@(II)=HDR_$C(30)
;
S TMFRAME=$$DATE^BQIUL1($G(TMFRAME))
I TMFRAME'="" S BDT=(9999999-DT)-.001,EDT=(9999999-TMFRAME)
I TMFRAME="" S BDT="",EDT=""
;
I BDT="",EDT="" D G SORT
. S TIUDA=""
. F S TIUDA=$O(^TIU(8925,"C",DFN,TIUDA)) Q:TIUDA="" D REC(TIUDA)
;
F S BDT=$O(^TIU(8925,"AE",DFN,BDT)) Q:BDT=""!(BDT>EDT) D
. S TITN=""
. F S TITN=$O(^TIU(8925,"AE",DFN,BDT,TITN)) Q:TITN="" D
.. S TIUDA=""
.. F S TIUDA=$O(^TIU(8925,"AE",DFN,BDT,TITN,TIUDA)) Q:TIUDA="" D REC(TIUDA)
;
SORT ;
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))
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
K ^TMP("BQITIULS_1",$J)
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
;
REC(TIUDA) ;
;
NEW TDTNTD,TDTCRT
;
;Pull CLASS - Do not return ADDENDUM records
S CLASS=$$GET1^DIQ(8925,TIUDA_",",.04,"E")
Q:CLASS="ADDENDUM"
;
S TITLE=$$GET1^DIQ(8925,TIUDA_",",.01,"I")
S:TITLE]"" TITLE=$P($G(^TIU(8925.1,TITLE,0)),U)
Q:TITLE="" ;Skip corrupted entries
;
S AUTHOR=$$GET1^DIQ(8925,TIUDA_",",1202,"E")
;
S TDTCRT=$$GET1^DIQ(8925,TIUDA_",",1201,"I")
S (TDTNTD,IXDT)=$$GET1^DIQ(8925,TIUDA_",",1301,"I")
I IXDT="" S IXDT=$S(TDTCRT]"":TDTCRT,1:"~")
;
S STATUS=$$GET1^DIQ(8925,TIUDA_",",.05,"E")
I STATUS'="COMPLETED" Q
S SUBJ=$$GET1^DIQ(8925,TIUDA_",",1701,"E")
;
S SRTCT=$G(SRTCT)+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)
Q
;
CNT(DATA,DFN) ; EP -- BQI DOC COUNT BY PAT
; Input Variables
; DFN - Patient Internal entry Number
;
NEW UID,II,HDR,TIUDA,TDTCRT,ARRAY,CT,EDT,BDT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITIUCT",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITIULS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="D00015FROM_DATE^D00015THRU_DATE^I00010NUM"
S @DATA@(II)=HDR_$C(30)
;
;
K ARRAY
S TIUDA="",CT=0
F S TIUDA=$O(^TIU(8925,"C",DFN,TIUDA)) Q:TIUDA="" D
. S TDTCRT=$$GET1^DIQ(8925,TIUDA_",",1201,"I")\1
. I TDTCRT=0 Q
. S ARRAY(TDTCRT)="",CT=CT+1
S BDT=$O(ARRAY("")),EDT=$O(ARRAY(""),-1)
I CT>0 S II=II+1,@DATA@(II)=$$FMTE^BQIUL1(BDT)_U_$$FMTE^BQIUL1(EDT)_U_CT_$C(30)
G DONE
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
+2 ;
LST(DATA,DFN,TMFRAME) ; EP -- BQI GET DOC LIST BY PAT
+1 ; Input Variables
+2 ; DFN - Patient Internal entry Number
+3 ; TMFRAME - Date time frame (a set of values e.g. 3 months = T-3M)
+4 ;
+5 NEW UID,II,HDR,AUTHOR,CLASS,IXDT,STATUS,TITLE,TIUDA,TITN,SUBJ,SRTCT
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BQITIULS",UID))
+8 KILL @DATA
+9 KILL ^TMP("BQITIULS_1",$JOB)
+10 ;
+11 SET II=0
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITIULS D UNWIND^%ZTER"
+13 ;
+14 SET HDR="T00060CLASS^T00060TITLE^T00080SUBJECT^D00030DATETIME^T00030STATUS^T00035AUTHOR^I00010TIUDA"
+15 SET @DATA@(II)=HDR_$CHAR(30)
+16 ;
+17 SET TMFRAME=$$DATE^BQIUL1($GET(TMFRAME))
+18 IF TMFRAME'=""
SET BDT=(9999999-DT)-.001
SET EDT=(9999999-TMFRAME)
+19 IF TMFRAME=""
SET BDT=""
SET EDT=""
+20 ;
+21 IF BDT=""
IF EDT=""
Begin DoDot:1
+22 SET TIUDA=""
+23 FOR
SET TIUDA=$ORDER(^TIU(8925,"C",DFN,TIUDA))
IF TIUDA=""
QUIT
DO REC(TIUDA)
End DoDot:1
GOTO SORT
+24 ;
+25 FOR
SET BDT=$ORDER(^TIU(8925,"AE",DFN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:1
+26 SET TITN=""
+27 FOR
SET TITN=$ORDER(^TIU(8925,"AE",DFN,BDT,TITN))
IF TITN=""
QUIT
Begin DoDot:2
+28 SET TIUDA=""
+29 FOR
SET TIUDA=$ORDER(^TIU(8925,"AE",DFN,BDT,TITN,TIUDA))
IF TIUDA=""
QUIT
DO REC(TIUDA)
End DoDot:2
End DoDot:1
+30 ;
SORT ;
+1 SET IXDT=""
FOR
SET IXDT=$ORDER(^TMP("BQITIULS_1",$JOB,IXDT),-1)
IF IXDT=""
QUIT
SET SRTCT=""
FOR
SET SRTCT=$ORDER(^TMP("BQITIULS_1",$JOB,IXDT,SRTCT))
IF SRTCT=""
QUIT
SET II=II+1
SET @DATA@(II)=$GET(^TMP("BQITIULS_1",$JOB,IXDT,SRTCT))
+2 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 KILL ^TMP("BQITIULS_1",$JOB)
+3 QUIT
+4 ;
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 ;
REC(TIUDA) ;
+1 ;
+2 NEW TDTNTD,TDTCRT
+3 ;
+4 ;Pull CLASS - Do not return ADDENDUM records
+5 SET CLASS=$$GET1^DIQ(8925,TIUDA_",",.04,"E")
+6 IF CLASS="ADDENDUM"
QUIT
+7 ;
+8 SET TITLE=$$GET1^DIQ(8925,TIUDA_",",.01,"I")
+9 IF TITLE]""
SET TITLE=$PIECE($GET(^TIU(8925.1,TITLE,0)),U)
+10 ;Skip corrupted entries
IF TITLE=""
QUIT
+11 ;
+12 SET AUTHOR=$$GET1^DIQ(8925,TIUDA_",",1202,"E")
+13 ;
+14 SET TDTCRT=$$GET1^DIQ(8925,TIUDA_",",1201,"I")
+15 SET (TDTNTD,IXDT)=$$GET1^DIQ(8925,TIUDA_",",1301,"I")
+16 IF IXDT=""
SET IXDT=$SELECT(TDTCRT]"":TDTCRT,1:"~")
+17 ;
+18 SET STATUS=$$GET1^DIQ(8925,TIUDA_",",.05,"E")
+19 IF STATUS'="COMPLETED"
QUIT
+20 SET SUBJ=$$GET1^DIQ(8925,TIUDA_",",1701,"E")
+21 ;
+22 SET SRTCT=$GET(SRTCT)+1
+23 SET ^TMP("BQITIULS_1",$JOB,IXDT,SRTCT)=CLASS_U_TITLE_U_SUBJ_U_$$FMTE^BQIUL1(TDTNTD)_U_STATUS_U_AUTHOR_U_TIUDA_$CHAR(30)
+24 QUIT
+25 ;
CNT(DATA,DFN) ; EP -- BQI DOC COUNT BY PAT
+1 ; Input Variables
+2 ; DFN - Patient Internal entry Number
+3 ;
+4 NEW UID,II,HDR,TIUDA,TDTCRT,ARRAY,CT,EDT,BDT
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("BQITIUCT",UID))
+7 KILL @DATA
+8 ;
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITIULS D UNWIND^%ZTER"
+11 ;
+12 SET HDR="D00015FROM_DATE^D00015THRU_DATE^I00010NUM"
+13 SET @DATA@(II)=HDR_$CHAR(30)
+14 ;
+15 ;
+16 KILL ARRAY
+17 SET TIUDA=""
SET CT=0
+18 FOR
SET TIUDA=$ORDER(^TIU(8925,"C",DFN,TIUDA))
IF TIUDA=""
QUIT
Begin DoDot:1
+19 SET TDTCRT=$$GET1^DIQ(8925,TIUDA_",",1201,"I")\1
+20 IF TDTCRT=0
QUIT
+21 SET ARRAY(TDTCRT)=""
SET CT=CT+1
End DoDot:1
+22 SET BDT=$ORDER(ARRAY(""))
SET EDT=$ORDER(ARRAY(""),-1)
+23 IF CT>0
SET II=II+1
SET @DATA@(II)=$$FMTE^BQIUL1(BDT)_U_$$FMTE^BQIUL1(EDT)_U_CT_$CHAR(30)
+24 GOTO DONE
