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

BQIDCASN.m

Go to the documentation of this file. 
  1. BQIDCASN ;VNGT/HS/ALA-'Patients Assigned To' ; 15 Sep 2006  5:18 PM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10
  1.  ;
  1.  Q
  1.  ;
  1. FND(FDATA,PARMS,MPARMS) ;EP - Find records
  1.  ;
  1.  ;Description
  1.  ;  Executable that finds all patients who are assigned to designated people
  1.  ;Input
  1.  ;  PARMS = Array of parameters and their values
  1.  ;  MPARMS = Multiple array of a parameter
  1.  ;Expected to return FDATA
  1.  ;
  1.  NEW UID,PSTMFRAM,PSVISITS,PTMFRAME,PVISITS,TYPE,VDATA,RFROM
  1.  NEW TEAM,CAT,TYP,PROV,NOTA,SPEC,QFL,VISIT,VSDTM,PPIEN,RTHRU
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S FDATA=$NA(^TMP(UID,"BQIDCASN")),VDATA=$NA(^TMP(UID,"BQIFND"))
  1.  K @FDATA,@VDATA
  1.  ;
  1.  ;  Set the parameters into variables
  1.  I '$D(PARMS) Q
  1.  ;
  1.  S NM="" F  S NM=$O(PARMS(NM)) Q:NM=""  S @NM=PARMS(NM)
  1.  S PROV=$G(PROV,""),TYPE=$G(TYPE,""),NOTA=$G(NOTA,"")
  1.  S PPIEN=$$PP^BQIDCDF("PATIENTS ASSIGNED TO")
  1.  ;
  1.  ; If panel is patient not assigned to a DPCP
  1.  I $G(NOTA)'="" D  Q
  1.  . NEW BQDFN
  1.  . S BQDFN=0
  1.  . F  S BQDFN=$O(^AUPNPAT(BQDFN)) Q:'BQDFN  D
  1.  .. I $P($G(^AUPNPAT(BQDFN,0)),"^",1)="" Q
  1.  .. I $P(^AUPNPAT(BQDFN,0),U,14)'="" Q
  1.  .. ; If patient has no active HRNs, quit
  1.  .. I '$$HRN^BQIUL1(BQDFN) Q
  1.  .. S @FDATA@(BQDFN)=""
  1.  ;
  1.  ; If team
  1.  I $G(TEAM)'="" D  Q
  1.  . S CAT=$$CT("DESIGNATED PRIMARY PROVIDER")
  1.  . S PROV=""
  1.  . F  S PROV=$O(^BSDPCT(TEAM,1,"B",PROV)) Q:PROV=""  D DP
  1.  . D SAV
  1.  ;
  1.  I '$D(MPARMS("TYPE")) D
  1.  . I TYPE="CMGR"!(TYPE="DPCP") S DATA=$NA(^TMP("BQIBDP",UID))
  1.  . I TYPE="PRIM"!(TYPE="PRSC") S DATA=$NA(^TMP("BQIPRV",UID))
  1.  . K @DATA
  1.  . I TYPE="PRIM" D PROV("P"),SAV Q
  1.  . I TYPE="PRSC" D PROV(""),SAV Q
  1.  . I TYPE="" Q
  1.  . D @TYPE,SAV
  1.  I $D(MPARMS("TYPE")) D
  1.  . ; types = CMGR,DPCP,PRIM,PRSC
  1.  . S TYP=""
  1.  . F  S TYP=$O(MPARMS("TYPE",TYP)) Q:TYP=""  D
  1.  .. I TYP="CMGR"!(TYP="DPCP") S DATA=$NA(^TMP("BQIBDP",UID))
  1.  .. I TYP="PRIM"!(TYP="PRSC") S DATA=$NA(^TMP("BQIPRV",UID))
  1.  .. K @DATA
  1.  .. I TYP="PRIM" D PROV("P"),SAV Q
  1.  .. I TYP="PRSC" D PROV(""),SAV Q
  1.  .. D @TYP,SAV
  1.  ;
  1.  Q
  1.  ;
  1. SAV ;  Save the data
  1.  K @FDATA
  1.  S DFN=""
  1.  F  S DFN=$O(@DATA@(DFN)) Q:DFN=""  S @FDATA@(DFN)=""
  1.  K @DATA
  1.  Q
  1.  ;
  1. CMGR ; Case Manager
  1.  I $$VERSION^XPDUTL("BDP")="" Q
  1.  ;  
  1.  NEW DFN,CAT,IEN,NM,IEN,Y,X,CSMGR
  1.  S CAT=$$CT("CASE MANAGER")
  1.  I 'CAT Q
  1.  ;
  1.  ;  Go through the BDP DESG SPECIALTY PROVIDER File to find any patient
  1.  ;  with the specified case manager
  1.  ;
  1.  I $D(MPARMS("PROV")) D
  1.  . S CSMGR=""
  1.  . F  S CSMGR=$O(MPARMS("PROV",CSMGR)) Q:CSMGR=""  S IEN="" D CM
  1.  I '$D(MPARMS("PROV")) S CSMGR=PROV,IEN="" D CM
  1.  Q
  1.  ;
  1. CM ;
  1.  F  S IEN=$O(^BDPRECN("AC",CSMGR,IEN)) Q:IEN=""  D
  1.  . ;I $$GET1^DIQ(90360.1,IEN_",",.01,"I")'=CAT Q
  1.  . I $P($G(^BDPRECN(IEN,0)),"^",1)'=CAT Q
  1.  . ;S DFN=$$GET1^DIQ(90360.1,IEN_",",.02,"I") I DFN="" Q
  1.  . S DFN=$P($G(^BDPRECN(IEN,0)),"^",2) I DFN="" Q
  1.  . S @DATA@(DFN)=""
  1.  Q
  1.  ;
  1. DPCP ;
  1.  ;  If the DSPM package is installed
  1.  I $$VERSION^XPDUTL("BDP")'="" D DSPM
  1.  ;
  1.  ;  If the DSPM package is NOT installed, use the alternate
  1.  ;  primary provider definition
  1.  I $$VERSION^XPDUTL("BDP")="" D
  1.  . I $D(MPARMS("PROV")) D
  1.  .. S PROV=""
  1.  .. F  S PROV=$O(MPARMS("PROV",PROV)) Q:PROV=""  S IEN="" D DP
  1.  . I '$D(MPARMS("PROV")) S IEN="" D DP
  1.  . Q
  1.  . NEW IEN
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNPAT("AK",PROV,IEN)) Q:IEN=""  D
  1.  .. S @DATA@(IEN)=""
  1.  Q
  1.  ;
  1. DSPM ;  Find the internal entry number
  1.  NEW DFN,DIC,IEN,Y,X
  1.  S CAT=$$CT("DESIGNATED PRIMARY PROVIDER")
  1.  I 'CAT Q
  1.  ;
  1.  I $D(MPARMS("PROV")) D
  1.  . S PROV=""
  1.  . F  S PROV=$O(MPARMS("PROV",PROV)) Q:PROV=""  S IEN="" D DP
  1.  I '$D(MPARMS("PROV")) S IEN="" D DP
  1.  Q
  1.  ;
  1. DP ;
  1.  S IEN=""
  1.  F  S IEN=$O(^BDPRECN("AC",PROV,IEN)) Q:IEN=""  D
  1.  . ;I $$GET1^DIQ(90360.1,IEN_",",.01,"I")'=CAT Q
  1.  . I $P($G(^BDPRECN(IEN,0)),"^",1)'=CAT Q
  1.  . ;S DFN=$$GET1^DIQ(90360.1,IEN_",",.02,"I") I DFN="" Q
  1.  . S DFN=$P($G(^BDPRECN(IEN,0)),"^",2) I DFN="" Q
  1.  . S @DATA@(DFN)=""
  1.  ;
  1.  ; Also check patient file
  1.  NEW IEN
  1.  S IEN=""
  1.  F  S IEN=$O(^AUPNPAT("AK",PROV,IEN)) Q:IEN=""  D
  1.  . S @DATA@(IEN)=""
  1.  Q
  1.  ;
  1. PROV(FLAG) ;EP - Primary or Primary/Secondary Providers
  1.  ; Input
  1.  ;   FLAG - "P" for Primary Only
  1.  ; 
  1.  NEW TMFRAME,VISITS,FDT,TDT,IEN
  1.  I $G(DT)="" D DT^DICRW
  1.  S FDT="",TDT=""
  1.  I FLAG="P" D
  1.  . I $G(PTMFRAME)'="" D
  1.  .. D RANGE^BQIDCAH1(PTMFRAME,PPIEN,"PTMFRAME")
  1.  .. S FDT=$G(RFROM,""),TDT=$G(RTHRU,"")
  1.  . S VISITS=$G(PVISITS,"")
  1.  I FLAG'="P" D
  1.  . I $G(PSTMFRAM)'="" D
  1.  .. D RANGE^BQIDCAH1(PSTMFRAM,PPIEN,"PSTMFRAM")
  1.  .. S FDT=$G(RFROM,""),TDT=$G(RTHRU,"")
  1.  . S VISITS=$G(PSVISITS,"")
  1.  S TDT=DT
  1.  I $G(PROV)'="" D PV
  1.  I $D(MPARMS("PROV")) D
  1.  . S PROV=""
  1.  . F  S PROV=$O(MPARMS("PROV",PROV)) Q:PROV=""  D PV
  1.  ;
  1.  S DFN=""
  1.  F  S DFN=$O(@VDATA@(DFN)) Q:DFN=""  D
  1.  . ;  if the number of visits for patient doesn't match the criteria, quit
  1.  . I @VDATA@(DFN)<VISITS Q  ;Changed from '= to <
  1.  . S @DATA@(DFN)=""
  1.  ;
  1.  K @VDATA
  1.  Q
  1.  ;
  1.  ;  Go through the V PROVIDER File for the designated provider and
  1.  ;  find out if they are a primary or secondary provider AND if the
  1.  ;  visit falls within the time frame
  1. PV ;
  1.  S IEN="",FLAG=$G(FLAG,"")
  1.  F  S IEN=$O(^AUPNVPRV("B",PROV,IEN),-1) Q:IEN=""  D
  1.  . ;I FLAG="P",$$GET1^DIQ(9000010.06,IEN_",",.04,"I")'="P" Q
  1.  . I FLAG="P",$P($G(^AUPNVPRV(IEN,0)),"^",4)'="P" Q
  1.  . ;S VISIT=$$GET1^DIQ(9000010.06,IEN_",",.03,"I") I VISIT="" Q
  1.  . S VISIT=$P($G(^AUPNVPRV(IEN,0)),"^",3) I VISIT="" Q
  1.  . ;S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSDTM=0 Q
  1.  . S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
  1.  . ;S DFN=$$GET1^DIQ(9000010.06,IEN_",",.02,"I") I DFN="" Q
  1.  . S DFN=$P($G(^AUPNVPRV(IEN,0)),"^",2) I DFN="" Q
  1.  . I $D(@FDATA)>0,'$D(@FDATA@(DFN)) Q
  1.  . ;
  1.  . I FDT'="" S QFL=0 D  Q:QFL
  1.  .. I VSDTM'<FDT,VSDTM'>TDT Q
  1.  .. S QFL=1
  1.  . ;  Count number of visits for a patient
  1.  . S @VDATA@(DFN)=$G(@VDATA@(DFN))+1
  1.  ; 
  1.  Q
  1.  ;
  1. SPEC ; Find the entries for a specialty provider
  1.  NEW IEN,SPC,IEN
  1.  ; If single specialty
  1.  I '$D(MPARMS("SPEC")) D
  1.  . ; Multiple providers
  1.  . I $D(MPARMS("PROV")) D
  1.  .. S PROV=""
  1.  .. F  S PROV=$O(MPARMS("PROV",PROV)) Q:PROV=""  S IEN="" D SPC(SPEC,PROV)
  1.  . ; Single Provider
  1.  . I '$D(MPARMS("PROV")) S IEN="" D SPC(SPEC,PROV) Q
  1.  ;
  1.  ; If multiple specialties
  1.  I $D(MPARMS("SPEC")) D
  1.  . S SPC=""
  1.  . F  S SPC=$O(MPARMS("SPEC",SPC),-1) Q:SPC=""  D
  1.  .. ; Multiple providers
  1.  .. I $D(MPARMS("PROV")) D
  1.  ... S PROV=""
  1.  ... F  S PROV=$O(MPARMS("PROV",PROV)) Q:PROV=""  S IEN="" D SPC(SPC,PROV)
  1.  .. ; Single Provider
  1.  .. I '$D(MPARMS("PROV")) S IEN="" D SPC(SPC,PROV) Q
  1.  Q
  1.  ;
  1. SPC(SPC,PRV) ;
  1.  S IEN=""
  1.  F  S IEN=$O(^BDPRECN("B",SPC,IEN)) Q:IEN=""  D
  1.  . I $P(^BDPRECN(IEN,0),U,3)'=PRV Q
  1.  . S DFN=$P(^BDPRECN(IEN,0),U,2)
  1.  . S @DATA@(DFN)=""
  1.  Q
  1.  ;
  1. CT(TEXT) ; Find value
  1.  Q $$FIND1^DIC(90360.3,,"X",TEXT)