BQITDRUN ;PRXM/HC/ALA-Diag Tag Run RPC ; 04 Sep 2007 5:15 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(DATA,BQIDFN) ; EP - BQI GET LAST DX CAT RUN
;
; Input
; BQIDFN - Patient IEN
;
; Get the beginning and ending times of the Diagnosis Tag run for this patient
NEW UID,II,LUPDT,X,DA,BUDT,BUEDT,HDR,DTLCHK
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITDRUN",UID))
K @DATA
S BQIDFN=$G(BQIDFN,"")
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITDRUN D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="D00030LAST_UPDATE_DATETIME"
;S HDR="D00030PATIENT_LAST_UPDATE^D00030LAST_UPDATE_START_DATETIME^D00030LAST_UPDATE_END_DATETIME^"
S @DATA@(II)=HDR_$C(30)
;
S DA=$O(^BQI(90508,0)) I 'DA G DONE
;
S BUEDT=$$GET1^DIQ(90508,DA_",",4.02,"I")
;
I BQIDFN="" S DTLCHK=BUEDT
I BQIDFN'="" D
. I $G(^BQIPAT(BQIDFN,0))="" S DTLCHK="" Q
. S DTLCHK=$S($P(^BQIPAT(BQIDFN,0),U,6)\1>(BUEDT\1):$P(^BQIPAT(BQIDFN,0),U,6),1:BUEDT)
;
FIN S II=II+1,@DATA@(II)=$$FMTE^BQIUL1(DTLCHK)_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
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
;
GLOS(DATA,FAKE) ;EP - BQI GET DX CAT GLOSSARY
;
NEW UID,II,DXCN,DXN,DXCAT,DC
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIDXHLP",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITDRUN D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="T00010DIAG_IEN^T00040DIAG_CAT^T00015DX_CAT^T01024DESC_TEXT"_$C(30)
;
S DXCN=""
F S DXCN=$O(^BQI(90506.2,"B",DXCN)) Q:DXCN="" D
. S DXN=""
. F S DXN=$O(^BQI(90506.2,"B",DXCN,DXN)) Q:DXN="" D
.. I $P(^BQI(90506.2,DXN,0),"^",3)=1 Q
.. I $P(^BQI(90506.2,DXN,0),"^",5)=1 Q
.. S DXCAT=$$GET1^DIQ(90506.2,DXN_",",.07,"E")
.. S DC=0
.. S II=II+1
.. S @DATA@(II)=DXN_"^"_DXCN_"^"_DXCAT_"^"
.. F S DC=$O(^BQI(90506.2,DXN,2,DC)) Q:'DC D
... S II=II+1,@DATA@(II)=^BQI(90506.2,DXN,2,DC,0)_$C(10)
.. S II=II+1,@DATA@(II)=$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
BQITDRUN ;PRXM/HC/ALA-Diag Tag Run RPC ; 04 Sep 2007 5:15 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(DATA,BQIDFN) ; EP - BQI GET LAST DX CAT RUN
+1 ;
+2 ; Input
+3 ; BQIDFN - Patient IEN
+4 ;
+5 ; Get the beginning and ending times of the Diagnosis Tag run for this patient
+6 NEW UID,II,LUPDT,X,DA,BUDT,BUEDT,HDR,DTLCHK
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQITDRUN",UID))
+9 KILL @DATA
+10 SET BQIDFN=$GET(BQIDFN,"")
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITDRUN D UNWIND^%ZTER"
+14 ;
+15 SET HDR="D00030LAST_UPDATE_DATETIME"
+16 ;S HDR="D00030PATIENT_LAST_UPDATE^D00030LAST_UPDATE_START_DATETIME^D00030LAST_UPDATE_END_DATETIME^"
+17 SET @DATA@(II)=HDR_$CHAR(30)
+18 ;
+19 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
GOTO DONE
+20 ;
+21 SET BUEDT=$$GET1^DIQ(90508,DA_",",4.02,"I")
+22 ;
+23 IF BQIDFN=""
SET DTLCHK=BUEDT
+24 IF BQIDFN'=""
Begin DoDot:1
+25 IF $GET(^BQIPAT(BQIDFN,0))=""
SET DTLCHK=""
QUIT
+26 SET DTLCHK=$SELECT($PIECE(^BQIPAT(BQIDFN,0),U,6)\1>(BUEDT\1):$PIECE(^BQIPAT(BQIDFN,0),U,6),1:BUEDT)
End DoDot:1
+27 ;
FIN SET II=II+1
SET @DATA@(II)=$$FMTE^BQIUL1(DTLCHK)_$CHAR(30)
+1 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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 ;
GLOS(DATA,FAKE) ;EP - BQI GET DX CAT GLOSSARY
+1 ;
+2 NEW UID,II,DXCN,DXN,DXCAT,DC
+3 ;
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 SET DATA=$NAME(^TMP("BQIDXHLP",UID))
+6 KILL @DATA
+7 ;
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITDRUN D UNWIND^%ZTER"
+10 SET @DATA@(II)="T00010DIAG_IEN^T00040DIAG_CAT^T00015DX_CAT^T01024DESC_TEXT"_$CHAR(30)
+11 ;
+12 SET DXCN=""
+13 FOR
SET DXCN=$ORDER(^BQI(90506.2,"B",DXCN))
IF DXCN=""
QUIT
Begin DoDot:1
+14 SET DXN=""
+15 FOR
SET DXN=$ORDER(^BQI(90506.2,"B",DXCN,DXN))
IF DXN=""
QUIT
Begin DoDot:2
+16 IF $PIECE(^BQI(90506.2,DXN,0),"^",3)=1
QUIT
+17 IF $PIECE(^BQI(90506.2,DXN,0),"^",5)=1
QUIT
+18 SET DXCAT=$$GET1^DIQ(90506.2,DXN_",",.07,"E")
+19 SET DC=0
+20 SET II=II+1
+21 SET @DATA@(II)=DXN_"^"_DXCN_"^"_DXCAT_"^"
+22 FOR
SET DC=$ORDER(^BQI(90506.2,DXN,2,DC))
IF 'DC
QUIT
Begin DoDot:3
+23 SET II=II+1
SET @DATA@(II)=^BQI(90506.2,DXN,2,DC,0)_$CHAR(10)
End DoDot:3
+24 SET II=II+1
SET @DATA@(II)=$CHAR(30)
End DoDot:2
End DoDot:1
+25 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+26 QUIT
