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

BQIDCREG.m

Go to the documentation of this file. 
  1. BQIDCREG ;PRXM/HC/ALA-RPMS Register Patients ; 04 Nov 2005  11:04 AM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
  1.  ;
  1.  Q
  1.  ;
  1. MYP(DATA,PARMS,MPARMS) ;EP
  1.  ;
  1.  ;Description
  1.  ;  Executable to retrieve those patients who are on a specified register
  1.  ;Input
  1.  ;  PARMS = Array of parameters and their values
  1.  ;  MPARMS = Multiple array of a parameter
  1.  ;Expected to return DATA
  1.  ;
  1.  NEW UID,NM,REGIEN,RDATA,FILE,FIELD,XREF,GLBREF,DFN,GLBNOD,RIEN,QFL,SUBREG
  1.  NEW II,X
  1.  NEW STAT,PSTAT,STFILE,STFLD,STEX,IENS
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),II=0
  1.  S DATA=$NA(^TMP("BQIDCREG",UID))
  1.  K @DATA
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIDCREG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S NM=""
  1.  F  S NM=$O(PARMS(NM)) Q:NM=""  S @NM=PARMS(NM)
  1.  ;
  1. FND ;  Determine where to find the patient cross-reference for the
  1.  ;  specified registry PARMS("REG")
  1.  ;Parameters
  1.  ;  REGIEN = Registry internal entry number
  1.  ;  FILE   = File number where registry resides
  1.  ;  FIELD  = Field number where patient is defined in the registry
  1.  ;  XREF   = The cross-reference of the patient in the registry file
  1.  ;  GLBREF = The global reference of the patient cross-reference
  1.  ;  GLBNOD = Closed root of the global
  1.  ;
  1.  S REGIEN=$G(PARMS("REG")) I REGIEN="" Q
  1.  S RDATA=^BQI(90507,REGIEN,0)
  1.  S FILE=$P(RDATA,"^",7),FIELD=$P(RDATA,"^",5),XREF=$P(RDATA,"^",6)
  1.  S STFILE=$P(RDATA,"^",15),STFLD=$P(RDATA,"^",14),STEX=$G(^BQI(90507,REGIEN,1))
  1.  I $G(SUBREG)="" S SUBREG=$P(RDATA,U,9)
  1.  S GLBREF=$$ROOT^DILFD(FILE,"")_XREF_")"
  1.  S GLBNOD=$$ROOT^DILFD(FILE,"",1)
  1.  I GLBNOD="" Q
  1.  ;
  1.  I '$D(@GLBNOD@(0)) Q
  1.  ;
  1.  S DFN=""
  1.  F  S DFN=$O(@GLBREF@(DFN)) Q:DFN=""  D
  1.  . ; If patient is deceased, quit
  1.  . ; User may now select Living, Deceased or both as a filter so
  1.  . ; if no filters defined assume living patients otherwise let filter decide
  1.  . ;I $O(^BQICARE(OWNR,1,PLIEN,15,0))="",$P($G(^DPT(DFN,.35)),U,1)'="" Q
  1.  . ; If patient has no active HRNs, quit
  1.  . I '$$HRN^BQIUL1(DFN) Q
  1.  . ; If patient has no visit in last 3 years, quit
  1.  . ;I '$$VTHR^BQIUL1(DFN) Q
  1.  . ;
  1.  . I $G(SUBREG)'="" S QFL=0 D  Q:'QFL
  1.  .. ;Q:FILE'=9002241
  1.  .. S RIEN=""
  1.  .. F  S RIEN=$O(@GLBREF@(DFN,RIEN)) Q:RIEN=""  D
  1.  ... I $P($G(@GLBNOD@(RIEN,0)),U,5)=SUBREG S QFL=1,IENS=RIEN
  1.  . ; Check register status
  1.  . I $D(PARMS("STAT"))!$D(MPARMS("STAT")) S QFL=0 D  Q:'QFL
  1.  .. ;S IENS=$O(@GLBREF@(DFN,""))
  1.  .. I $G(SUBREG)="" S IENS=$O(@GLBREF@(DFN,""))
  1.  .. I STEX'="" X STEX Q:'$D(IENS)
  1.  .. I STEX="" S PSTAT=$$GET1^DIQ(STFILE,IENS,STFLD,"I")
  1.  .. I $D(PARMS("STAT")),PSTAT=PARMS("STAT") S QFL=1 Q
  1.  .. S STAT=""
  1.  .. F  S STAT=$O(MPARMS("STAT",STAT)) Q:STAT=""  I PSTAT=STAT S QFL=1 Q
  1.  . S @DATA@(DFN)=""
  1.  Q
  1.  ;
  1. HMS ; Set IENS for HMS Registry
  1.  N DA
  1.  S DA(1)=$O(^BKM(90451,"B",DFN,"")) Q:'DA(1)
  1.  S DA=$O(^BKM(90451,DA(1),1,0)) Q:'DA
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S PSTAT=$$GET1^DIQ(STFILE,IENS,STFLD,"I")
  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(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q