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

BQITDINS.m

Go to the documentation of this file. 
  1. BQITDINS ;GDIT/HS/ALA-Active Insurance ; 17 Dec 2014  7:48 AM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
  1.  ;
  1.  ;
  1. EN ; EP
  1.  NEW DFN,BQI,BQIDATA
  1.  S DFN=0
  1.  F  S DFN=$O(^BQIPAT(DFN)) Q:'DFN  D
  1.  . ; Remove previous insurance
  1.  . NEW DA,DIK
  1.  . S DA(1)=DFN,DA=0,DIK="^BQIPAT("_DA(1)_",70,"
  1.  . F  S DA=$O(^BQIPAT(DFN,70,DA)) Q:'DA  D ^DIK
  1.  . K BQIDATA
  1.  . D GET(DFN)
  1.  . I BQI=0 Q
  1.  . ;  if the patient doesn't already exist in the iCare Patient file, add them
  1.  . I $G(^BQIPAT(DFN,0))="" D NPT^BQITASK(DFN)
  1.  . S DA(1)=DFN
  1.  . I '$D(^BQIPAT(DFN,70,0)) S ^BQIPAT(DFN,20,0)="^90507.57^^"
  1.  . F I=1:1:BQI D
  1.  .. NEW DIC,DLAYGO,X,IENS,X,Y
  1.  .. S DIC(0)="L",DIC="^BQIPAT("_DA(1)_",70,",DLAYGO=90507.57,DIC("P")=DLAYGO
  1.  .. S X=$P(BQIDATA(I),"^",1)
  1.  .. K DO,DD D FILE^DICN
  1.  .. S DA=+Y S:DA=-1 DA=1
  1.  .. S IENS=$$IENS^DILF(.DA)
  1.  .. S BQIUPD(90507.57,IENS,.01)=X,BQIUPD(90507.57,IENS,.02)=$P(BQIDATA(I),"^",2)
  1.  .. S BQIUPD(90507.57,IENS,.03)=$P(BQIDATA(I),"^",3)
  1.  .. D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  Q
  1.  ;
  1. GET(DFN) ; EP -- BQI PATIENT INSURANCE
  1.  ;
  1.  S BQI=0
  1.  ;
  1.  ;  Check for Medicare
  1.  I $G(^AUPNMCR(DFN,0))'="" D
  1.  . S INSCO=$$GET1^DIQ(9000003,DFN_",",.02,"E")
  1.  . S IEN=0
  1.  . F  S IEN=$O(^AUPNMCR(DFN,11,IEN)) Q:'IEN  D
  1.  .. NEW DA,IENS,EFF,EXP,INSC
  1.  .. S DA(1)=DFN,DA=IEN,IENS=$$IENS^DILF(.DA)
  1.  .. S EFF=$$GET1^DIQ(9000003.11,IENS,.01,"I")
  1.  .. S EXP=$$GET1^DIQ(9000003.11,IENS,.02,"I")
  1.  .. I '$$ISACTIVE(EFF,EXP) Q
  1.  .. S INSC=$$GET1^DIQ(9000003,DFN_",",.02,"I")
  1.  .. S BQI=BQI+1
  1.  .. S BQIDATA(BQI)=INSCO_" "_$$GET1^DIQ(9000003.11,IENS,.03,"E")_"^"_INSC_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000003.11,IENS,.01,"I"))
  1.  ;
  1.  ;  Check for Railroad
  1.  I $G(^AUPNRRE(DFN,0))'="" D
  1.  . S INSCO=$$GET1^DIQ(9000005,DFN_",",.02,"E")
  1.  . S IEN=0
  1.  . F  S IEN=$O(^AUPNRRE(DFN,11,IEN)) Q:'IEN  D
  1.  .. NEW DA,IENS,EFF,EXP,INSC
  1.  .. S DA(1)=DFN,DA=IEN,IENS=$$IENS^DILF(.DA)
  1.  .. S EFF=$$GET1^DIQ(9000005.11,IENS,.01,"I")
  1.  .. S EXP=$$GET1^DIQ(9000005.11,IENS,.02,"I")
  1.  .. I '$$ISACTIVE(EFF,EXP) Q
  1.  .. S INSC=$$GET1^DIQ(9000005,DFN_",",.02,"I")
  1.  .. S BQI=BQI+1
  1.  .. S BQIDATA(BQI)=INSCO_" "_$$GET1^DIQ(9000005.11,IENS,.03,"E")_"^"_INSC_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000005.11,IENS,.01,"I"))
  1.  ;
  1.  ;  Check for Medicaid
  1.  S IEN=""
  1.  F  S IEN=$O(^AUPNMCD("B",DFN,IEN)) Q:IEN=""  D
  1.  . S INSCO=$$GET1^DIQ(9000004,IEN_",",.02,"E")
  1.  . S MN=0
  1.  . F  S MN=$O(^AUPNMCD(IEN,11,MN)) Q:'MN  D
  1.  .. NEW DA,IENS,EFF,EXP,INSC
  1.  .. S DA(1)=IEN,DA=MN,IENS=$$IENS^DILF(.DA)
  1.  .. S EFF=$$GET1^DIQ(9000004.11,IENS,.01,"I")
  1.  .. S EXP=$$GET1^DIQ(9000004.11,IENS,.02,"I")
  1.  .. I '$$ISACTIVE(EFF,EXP) Q
  1.  .. S INSC=$$GET1^DIQ(9000004,IEN_",",.02,"I")
  1.  .. S BQI=BQI+1
  1.  .. S BQIDATA(BQI)=INSCO_" "_$$GET1^DIQ(9000004.11,IENS,.03,"E")_"^"_INSC_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000004.11,IENS,.01,"I"))
  1.  ;
  1.  ;  Check for Private Insurance
  1.  N AGD S AGD=0
  1.  F  S AGD=$O(^AUPNPRVT(DFN,11,AGD)) Q:'AGD  D
  1.  . N DA,IENS,EFF,EXP,POLH,COV,INSC
  1.  . S DA(1)=DFN,DA=AGD,IENS=$$IENS^DILF(.DA)
  1.  . S EFF=$$GET1^DIQ(9000006.11,IENS,".06","I")
  1.  . S EXP=$$GET1^DIQ(9000006.11,IENS,".07","I")
  1.  . I '$$ISACTIVE(EFF,EXP) Q
  1.  . S POLH=$$GET1^DIQ(9000006.11,IENS,".08","I")
  1.  . S INSC=$$GET1^DIQ(9000006.11,IENS,".01","I")
  1.  . S COV="" S:POLH]"" COV=$$GET1^DIQ(9000003.1,POLH_",",".05","E")
  1.  . S BQI=BQI+1
  1.  . S BQIDATA(BQI)=$$GET1^DIQ(9000006.11,IENS,".01","E")_" "_COV_"^"_INSC_"^"_$$FMTE^BQIUL1(EFF)
  1.  Q
  1.  ;
  1.  ;
  1. ISACTIVE(EFFDT,ENDDT) ;EP - POL. ACTIVE TODAY?
  1.  N OPENEND
  1.  I EFFDT="",(ENDDT="") Q 0
  1.  S ENDDT=ENDDT
  1.  S OPENEND=ENDDT=""
  1.  I OPENEND I DT=EFFDT!(DT>EFFDT) Q 1
  1.  I DT=EFFDT!(DT=ENDDT) Q 1
  1.  I DT>EFFDT&(DT<ENDDT) Q 1
  1.  Q 0