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

BQIRRD.m

Go to the documentation of this file. 
  1. BQIRRD ;PRXM/HC/DLS - Patient Radiology ; 18 Jan 2006  12:02 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,DFN,DRANGE) ; EP -- BQI PATIENT RADIOLOGY
  1.  ;Description
  1.  ; Generates a Radiology Report for a given DFN and Relative Date.
  1.  ;
  1.  ;Input
  1.  ;  DFN  -  Patient IEN
  1.  ;  DRANGE - Date to pull Patient Radiology events from (to the present).
  1.  ;
  1.  ;Output
  1.  ;  DATA - Name of global in which data is stored(^TMP("BQIRRD"))
  1.  ;
  1.  N BQII,UID,X,RAD,DA,IENS,RADDT,RRADDT,RADIEN,VISIT
  1.  N DATE,PROC,ABNR,RADCODE,CPTCODE,RDRANGE,ORPHY,IMPRS
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIRRD",UID))
  1.  K @DATA
  1.  ;
  1.  S BQII=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRRD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  S DRANGE=$$DATE^BQIUL1($G(DRANGE))
  1.  S RDRANGE=9999999-DRANGE
  1.  S RAD=""
  1.  F  S RAD=$O(^AUPNVRAD("AA",DFN,RAD)) Q:RAD=""  D
  1.  . S RADDT=0
  1.  . F  S RADDT=$O(^AUPNVRAD("AA",DFN,RAD,RADDT)) Q:RADDT=""!(RADDT>RDRANGE)  D
  1.  . . S RADIEN=0
  1.  . . F  S RADIEN=$O(^AUPNVRAD("AA",DFN,RAD,RADDT,RADIEN)) Q:RADIEN=""  D
  1.  . . . S RRADDT=9999999-RADDT
  1.  . . . S DA=RADIEN
  1.  . . . S IENS=$$IENS^DILF(.DA)
  1.  . . . S DATE=$$FMTE^BQIUL1(RRADDT)
  1.  . . . S PROC=$$GET1^DIQ(9000010.22,IENS,".01","E")
  1.  . . . S VISIT=$$GET1^DIQ(9000010.22,IENS,".03","I") I VISIT="" Q
  1.  . . . S ABNR=$$GET1^DIQ(9000010.22,IENS,".05","E")
  1.  . . . S RADCODE=$$GET1^DIQ(9000010.22,IENS,.01,"I")
  1.  . . . S ORPHY=$$GET1^DIQ(9000010.22,IENS,1202,"E")
  1.  . . . S IMPRS=$$GET1^DIQ(9000010.22,IENS,1101,"E")
  1.  . . . S CPTCODE=$$GET1^DIQ(71,RADCODE,"9","E")
  1.  . . . S BQII=BQII+1,@DATA@(BQII)=VISIT_"^"_DATE_"^"_PROC_"^"_IMPRS_"^"_ABNR_"^"_ORPHY_$C(30)
  1.  ;
  1.  ; Check for refusals
  1.  D REF
  1.  ;
  1. DONE ;
  1.  S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. HDR ;
  1.  S @DATA@(BQII)="I00010VISIT_IEN^D00030VISIT_DATETIME^T00100RAD_PROC^T00245RAD_IMPRESSION^T00010RAD_ABNR^T00035RAD_ORD_PHY"_$C(30)
  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(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. REF ; Check for refusals
  1.  NEW XRN,RVDT,REVDT,RFIEN,PROC,IMPRS,ORPHY,ABNR,VISIT
  1.  S XRN=""
  1.  F  S XRN=$O(^AUPNPREF("AA",DFN,71,XRN)) Q:XRN=""  D
  1.  . S RVDT=""
  1.  . F  S RVDT=$O(^AUPNPREF("AA",DFN,71,XRN,RVDT)) Q:RVDT=""  D
  1.  .. ; Reverse the reverse date
  1.  .. S REVDT=9999999-RVDT
  1.  .. I DRANGE'="",(REVDT\1)<DRANGE Q
  1.  .. S RFIEN=""
  1.  .. F  S RFIEN=$O(^AUPNPREF("AA",DFN,71,XRN,RVDT,RFIEN)) Q:RFIEN=""  D
  1.  ... S PROC=$$GET1^DIQ(71,XRN_",",.01,"E")
  1.  ... S IMPRS=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
  1.  ... S ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
  1.  ... S ABNR="",VISIT=""
  1.  ... S BQII=BQII+1,@DATA@(BQII)=VISIT_"^"_$$FMTE^BQIUL1(REVDT)_"^"_PROC_"^"_IMPRS_"^"_ABNR_"^"_ORPHY_$C(30)
  1.  Q