- 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
