BQIRRD ;PRXM/HC/DLS - Patient Radiology ; 18 Jan 2006 12:02 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(DATA,DFN,DRANGE) ; EP -- BQI PATIENT RADIOLOGY
;Description
; Generates a Radiology Report for a given DFN and Relative Date.
;
;Input
; DFN - Patient IEN
; DRANGE - Date to pull Patient Radiology events from (to the present).
;
;Output
; DATA - Name of global in which data is stored(^TMP("BQIRRD"))
;
N BQII,UID,X,RAD,DA,IENS,RADDT,RRADDT,RADIEN,VISIT
N DATE,PROC,ABNR,RADCODE,CPTCODE,RDRANGE,ORPHY,IMPRS
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRRD",UID))
K @DATA
;
S BQII=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRRD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D HDR
S DRANGE=$$DATE^BQIUL1($G(DRANGE))
S RDRANGE=9999999-DRANGE
S RAD=""
F S RAD=$O(^AUPNVRAD("AA",DFN,RAD)) Q:RAD="" D
. S RADDT=0
. F S RADDT=$O(^AUPNVRAD("AA",DFN,RAD,RADDT)) Q:RADDT=""!(RADDT>RDRANGE) D
. . S RADIEN=0
. . F S RADIEN=$O(^AUPNVRAD("AA",DFN,RAD,RADDT,RADIEN)) Q:RADIEN="" D
. . . S RRADDT=9999999-RADDT
. . . S DA=RADIEN
. . . S IENS=$$IENS^DILF(.DA)
. . . S DATE=$$FMTE^BQIUL1(RRADDT)
. . . S PROC=$$GET1^DIQ(9000010.22,IENS,".01","E")
. . . S VISIT=$$GET1^DIQ(9000010.22,IENS,".03","I") I VISIT="" Q
. . . S ABNR=$$GET1^DIQ(9000010.22,IENS,".05","E")
. . . S RADCODE=$$GET1^DIQ(9000010.22,IENS,.01,"I")
. . . S ORPHY=$$GET1^DIQ(9000010.22,IENS,1202,"E")
. . . S IMPRS=$$GET1^DIQ(9000010.22,IENS,1101,"E")
. . . S CPTCODE=$$GET1^DIQ(71,RADCODE,"9","E")
. . . S BQII=BQII+1,@DATA@(BQII)=VISIT_"^"_DATE_"^"_PROC_"^"_IMPRS_"^"_ABNR_"^"_ORPHY_$C(30)
;
; Check for refusals
D REF
;
DONE ;
S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
;
HDR ;
S @DATA@(BQII)="I00010VISIT_IEN^D00030VISIT_DATETIME^T00100RAD_PROC^T00245RAD_IMPRESSION^T00010RAD_ABNR^T00035RAD_ORD_PHY"_$C(30)
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(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
Q
;
REF ; Check for refusals
NEW XRN,RVDT,REVDT,RFIEN,PROC,IMPRS,ORPHY,ABNR,VISIT
S XRN=""
F S XRN=$O(^AUPNPREF("AA",DFN,71,XRN)) Q:XRN="" D
. S RVDT=""
. F S RVDT=$O(^AUPNPREF("AA",DFN,71,XRN,RVDT)) Q:RVDT="" D
.. ; Reverse the reverse date
.. S REVDT=9999999-RVDT
.. I DRANGE'="",(REVDT\1)<DRANGE Q
.. S RFIEN=""
.. F S RFIEN=$O(^AUPNPREF("AA",DFN,71,XRN,RVDT,RFIEN)) Q:RFIEN="" D
... S PROC=$$GET1^DIQ(71,XRN_",",.01,"E")
... S IMPRS=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
... S ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
... S ABNR="",VISIT=""
... S BQII=BQII+1,@DATA@(BQII)=VISIT_"^"_$$FMTE^BQIUL1(REVDT)_"^"_PROC_"^"_IMPRS_"^"_ABNR_"^"_ORPHY_$C(30)
Q
BQIRRD ;PRXM/HC/DLS - Patient Radiology ; 18 Jan 2006 12:02 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(DATA,DFN,DRANGE) ; EP -- BQI PATIENT RADIOLOGY
+1 ;Description
+2 ; Generates a Radiology Report for a given DFN and Relative Date.
+3 ;
+4 ;Input
+5 ; DFN - Patient IEN
+6 ; DRANGE - Date to pull Patient Radiology events from (to the present).
+7 ;
+8 ;Output
+9 ; DATA - Name of global in which data is stored(^TMP("BQIRRD"))
+10 ;
+11 NEW BQII,UID,X,RAD,DA,IENS,RADDT,RRADDT,RADIEN,VISIT
+12 NEW DATE,PROC,ABNR,RADCODE,CPTCODE,RDRANGE,ORPHY,IMPRS
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIRRD",UID))
+15 KILL @DATA
+16 ;
+17 SET BQII=0
+18 ;
+19 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRRD D UNWIND^%ZTER"
+20 ;
+21 DO HDR
+22 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
+23 SET RDRANGE=9999999-DRANGE
+24 SET RAD=""
+25 FOR
SET RAD=$ORDER(^AUPNVRAD("AA",DFN,RAD))
IF RAD=""
QUIT
Begin DoDot:1
+26 SET RADDT=0
+27 FOR
SET RADDT=$ORDER(^AUPNVRAD("AA",DFN,RAD,RADDT))
IF RADDT=""!(RADDT>RDRANGE)
QUIT
Begin DoDot:2
+28 SET RADIEN=0
+29 FOR
SET RADIEN=$ORDER(^AUPNVRAD("AA",DFN,RAD,RADDT,RADIEN))
IF RADIEN=""
QUIT
Begin DoDot:3
+30 SET RRADDT=9999999-RADDT
+31 SET DA=RADIEN
+32 SET IENS=$$IENS^DILF(.DA)
+33 SET DATE=$$FMTE^BQIUL1(RRADDT)
+34 SET PROC=$$GET1^DIQ(9000010.22,IENS,".01","E")
+35 SET VISIT=$$GET1^DIQ(9000010.22,IENS,".03","I")
IF VISIT=""
QUIT
+36 SET ABNR=$$GET1^DIQ(9000010.22,IENS,".05","E")
+37 SET RADCODE=$$GET1^DIQ(9000010.22,IENS,.01,"I")
+38 SET ORPHY=$$GET1^DIQ(9000010.22,IENS,1202,"E")
+39 SET IMPRS=$$GET1^DIQ(9000010.22,IENS,1101,"E")
+40 SET CPTCODE=$$GET1^DIQ(71,RADCODE,"9","E")
+41 SET BQII=BQII+1
SET @DATA@(BQII)=VISIT_"^"_DATE_"^"_PROC_"^"_IMPRS_"^"_ABNR_"^"_ORPHY_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+42 ;
+43 ; Check for refusals
+44 DO REF
+45 ;
DONE ;
+1 SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+2 QUIT
+3 ;
HDR ;
+1 SET @DATA@(BQII)="I00010VISIT_IEN^D00030VISIT_DATETIME^T00100RAD_PROC^T00245RAD_IMPRESSION^T00010RAD_ABNR^T00035RAD_ORD_PHY"_$CHAR(30)
+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(BQII)
IF $DATA(DATA)
SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(31)
+6 QUIT
+7 ;
REF ; Check for refusals
+1 NEW XRN,RVDT,REVDT,RFIEN,PROC,IMPRS,ORPHY,ABNR,VISIT
+2 SET XRN=""
+3 FOR
SET XRN=$ORDER(^AUPNPREF("AA",DFN,71,XRN))
IF XRN=""
QUIT
Begin DoDot:1
+4 SET RVDT=""
+5 FOR
SET RVDT=$ORDER(^AUPNPREF("AA",DFN,71,XRN,RVDT))
IF RVDT=""
QUIT
Begin DoDot:2
+6 ; Reverse the reverse date
+7 SET REVDT=9999999-RVDT
+8 IF DRANGE'=""
IF (REVDT\1)<DRANGE
QUIT
+9 SET RFIEN=""
+10 FOR
SET RFIEN=$ORDER(^AUPNPREF("AA",DFN,71,XRN,RVDT,RFIEN))
IF RFIEN=""
QUIT
Begin DoDot:3
+11 SET PROC=$$GET1^DIQ(71,XRN_",",.01,"E")
+12 SET IMPRS=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
+13 SET ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
+14 SET ABNR=""
SET VISIT=""
+15 SET BQII=BQII+1
SET @DATA@(BQII)=VISIT_"^"_$$FMTE^BQIUL1(REVDT)_"^"_PROC_"^"_IMPRS_"^"_ABNR_"^"_ORPHY_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
