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

BQIPTVS.m

Go to the documentation of this file. 
  1. BQIPTVS ;PRXM/HC/BWF-Patient Visit Utilities ; 15 Nov 2005  3:17 PM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43
  1.  ;
  1.  ;
  1.  ; This is a utility program containing special function calls
  1.  ; needed for patient visit data.
  1.  Q
  1.  ;
  1. PNLVST(DATA,DFN,DRANGE) ; EP -- BQI PATIENT RECENT VISITS
  1.  ;
  1.  ; Description:
  1.  ;   Function used to gather visit information for a patient for a relative date range.
  1.  ;   Gathers provider name ICD narrative, POV narrative, and clinic.
  1.  ;   This function will gather 1.) A list of visit related information based on a date range
  1.  ;                             2.) If no date is provided, all visits will be reported.
  1.  ;
  1.  ;   Use date range to drive through visits.
  1.  ;   
  1.  ; Input
  1.  ;   DFN (Required)     - Patient IEN
  1.  ;   DRANGE - Date to pull past appointments from (to the present).
  1.  ;   
  1.  ; Output
  1.  ;   Global array containing information for patients.
  1.  ;   ^TMP("BQIPTVS",UID,BQII)=VISIT DATE_^_CLINIC_^_PROVIDER NAME_^_ICD NARRATIVE_^_POV NARRATIVE
  1.  ;
  1.  ; Variables
  1.  ;   DFN           - Patient Identifier
  1.  ;   VSTDT         - Visit Date
  1.  ;   VSTIEN        - Visit IEN
  1.  ;
  1.  N VSTIEN,VSTDT,RDRANGE,BQII,UID,X
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTVS",UID))
  1.  K @DATA
  1.  S BQII=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTVS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  ;
  1.  S DRANGE=$$DATE^BQIUL1($G(DRANGE))
  1.  S RDRANGE=9999999-DRANGE+1   ; Add one day to include visits on that day.
  1.  ;                            ; Otherwise, they will not be included.
  1.  S VSTDT=""
  1.  F  S VSTDT=$O(^AUPNVSIT("AA",DFN,VSTDT)) Q:(VSTDT="")!(VSTDT>RDRANGE)  D
  1.  .S VSTIEN=0
  1.  .F  S VSTIEN=$O(^AUPNVSIT("AA",DFN,VSTDT,VSTIEN)) Q:VSTIEN=""  D
  1.  ..D VSTDATA(VSTIEN,.BQII)
  1.  ;
  1.  ; DROP DOWN TO DONE
  1.  ;
  1. DONE ;
  1.  S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. VSTDATA(VSTIEN,BQII) ;EP
  1.  ;Gather visit date, visit provider, clinic, ICD narrative, POV code narrative,
  1.  ; and provider narrative for each patient and set into global array ^TMP("BQIPTVS",UID).
  1.  ;
  1.  ; Input
  1.  ;  VSTIEN - Visit IEN
  1.  ;  BQII   - Increment variable for output.
  1.  ;
  1.  ; Output
  1.  ;   Global array containing information for patients.
  1.  ;   ^TMP("BQIPTVS",UID,BQII)=VISIT IEN^VISIT DATE_^_CLINIC_^_PROVIDER NAME_^_ICD NARRATIVE_^_POV NARRATIVE
  1.  ;
  1.  ; Variables
  1.  ;   VSTDT         - Visit Date
  1.  ;   VPRVIEN       - Provider IEN(s) for last visit
  1.  ;   VPOVIEN       - V POV file IEN
  1.  ;       
  1.  N CLINIC,VPRVIEN,VSTDT,PRIMPROV,ICDNAR,ICDNSTR,POVNAR,POVNSTR,VPOVIEN,CLN,CSTCD
  1.  S VSTDT=$$GET1^DIQ(9000010,VSTIEN,.01,"I")
  1.  ; If visit has been deleted, don't include
  1.  I $$GET1^DIQ(9000010,VSTIEN_",",.11,"I")=1 Q
  1.  S CLN=$$GET1^DIQ(9000010,VSTIEN,.08,"I"),CSTCD=""
  1.  I CLN'="" S CSTCD=$$GET1^DIQ(40.7,CLN_",",1,"E")
  1.  S CLINIC=$$GET1^DIQ(9000010,VSTIEN,.08,"E")_" "_CSTCD
  1.  ;
  1.  ; Loop through providers. Only primary providers will be returned.
  1.  S VPRVIEN=0,PRIMPROV=""
  1.  F  S VPRVIEN=$O(^AUPNVPRV("AD",VSTIEN,VPRVIEN)) Q:VPRVIEN=""  D
  1.  .I $$GET1^DIQ(9000010.06,VPRVIEN,.04,"I")'="P" Q
  1.  .S PRIMPROV=$$GET1^DIQ(9000010.06,VPRVIEN,.01,"E")
  1.  S BQII=BQII+1,@DATA@(BQII)=VSTIEN_U_$$FMTE^BQIUL1(VSTDT)_U_CLINIC_U_PRIMPROV
  1.  ;
  1.  ; Gather all ICD narratives, separated by a LF/CR.
  1.  S VPOVIEN=0,ICDNSTR=""
  1.  F  S VPOVIEN=$O(^AUPNVPOV("AD",VSTIEN,VPOVIEN)) Q:VPOVIEN=""  D
  1.  .S ICDNAR=$$GET1^DIQ(9000010.07,VPOVIEN,".019","E")
  1.  .S ICDNST=$$GET1^DIQ(9000010.07,VPOVIEN,".01","E")
  1.  .I ICDNAR'="" S ICDNSTR=ICDNSTR_ICDNST_" "_ICDNAR_$C(13)_$C(10)
  1.  ;
  1.  ; Gather all POV narratives, separated by a LF/CR.
  1.  S VPOVIEN=0,POVNSTR=""
  1.  F  S VPOVIEN=$O(^AUPNVPOV("AD",VSTIEN,VPOVIEN)) Q:VPOVIEN=""  D
  1.  .S POVNAR=$$GET1^DIQ(9000010.07,VPOVIEN,".04","E")
  1.  .I POVNAR'="" S POVNSTR=$S(POVNSTR'="":POVNSTR_$C(13)_$C(10)_POVNAR,1:POVNAR)
  1.  ;
  1.  S @DATA@(BQII)=@DATA@(BQII)_U_ICDNSTR_U_POVNSTR_$C(30)
  1.  Q
  1.  ;
  1. HDR ;
  1.  S @DATA@(BQII)="I00010VST_IEN^D00015VST_DT^T00050VST_CLIN^T00050VST_PROV^T01000VST_ICD^T01000VST_POV"_$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