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

BQIPTINS.m

Go to the documentation of this file. 
  1. BQIPTINS ;GDIT/HS/ALA-Patient Insurance ; 05 Jul 2006  3:31 PM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
  1.  ;
  1.  Q
  1.  ;
  1. GET(DATA,DFN) ; EP -- BQI PATIENT INSURANCE
  1.  NEW UID,II,INSCO,X,INSCO,IEN,MN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTINS",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTINS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="T00100INSURANCE_COVERAGE^D00015EFFECTIVE_DATE"_$C(30)
  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
  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 II=II+1,@DATA@(II)=INSCO_" "_$$GET1^DIQ(9000003.11,IENS,.03,"E")_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000003.11,IENS,.01,"I"))_$C(30)
  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
  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 II=II+1,@DATA@(II)=INSCO_" "_$$GET1^DIQ(9000005.11,IENS,.03,"E")_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000005.11,IENS,.01,"I"))_$C(30)
  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
  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 II=II+1,@DATA@(II)=INSCO_" "_$$GET1^DIQ(9000004.11,IENS,.03,"E")_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000004.11,IENS,.01,"I"))_$C(30)
  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
  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 COV="" S:POLH]"" COV=$$GET1^DIQ(9000003.1,POLH_",",".05","E")
  1.  . S II=II+1,@DATA@(II)=$$GET1^DIQ(9000006.11,IENS,".01","E")_" "_COV_"^"_$$FMTE^BQIUL1(EFF)_$C(30)
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  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
  1.  ;
  1. LYO(DFN) ;EP - Layout display
  1.  NEW RESULT,INSCO,IEN,QFL,MN
  1.  ;  Check for Medicare
  1.  S RESULT=""
  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
  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 RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000003.11,IENS,.03,"E")_"; "_$C(13)_$C(10)
  1.  ;
  1.  ;  Check for Medicaid
  1.  S IEN="",QFL=0
  1.  F  S IEN=$O(^AUPNMCD("B",DFN,IEN)) Q:IEN=""  D  Q:QFL
  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
  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 RESULT=RESULT_INSCO_"; "_$C(13)_$C(10),QFL=1
  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
  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 RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000005.11,IENS,.03,"E")_"; "_$C(13)_$C(10)
  1.  ;
  1.  ;  Check for Private Insurance
  1.  S IEN=""
  1.  F  S IEN=$O(^AUPN3PPH("C",DFN,IEN)) Q:IEN=""  D
  1.  . ;I $$GET1^DIQ(9000003.1,IEN_",",.18,"I")'="" Q
  1.  . S EFF=$$GET1^DIQ(9000003.1,IEN,.17,"I")
  1.  . S EXP=$$GET1^DIQ(9000003.1,IEN,.18,"I")
  1.  . I '$$ISACTIVE(EFF,EXP) Q
  1.  . S INSCO=$$GET1^DIQ(9000003.1,IEN_",",.03,"E")
  1.  . S RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000003.1,IEN_",",.05,"E")_"; "_$C(13)_$C(10)
  1.  S RESULT=$$TKO^BQIUL1(RESULT,"; "_$C(13)_$C(10))
  1.  Q RESULT
  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