BQIPTINS ;GDIT/HS/ALA-Patient Insurance ; 05 Jul 2006 3:31 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
;
Q
;
GET(DATA,DFN) ; EP -- BQI PATIENT INSURANCE
NEW UID,II,INSCO,X,INSCO,IEN,MN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTINS",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTINS D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00100INSURANCE_COVERAGE^D00015EFFECTIVE_DATE"_$C(30)
;
; Check for Medicare
I $G(^AUPNMCR(DFN,0))'="" D
. S INSCO=$$GET1^DIQ(9000003,DFN_",",.02,"E")
. S IEN=0
. F S IEN=$O(^AUPNMCR(DFN,11,IEN)) Q:'IEN D
.. NEW DA,IENS,EFF,EXP
.. S DA(1)=DFN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S EFF=$$GET1^DIQ(9000003.11,IENS,.01,"I")
.. S EXP=$$GET1^DIQ(9000003.11,IENS,.02,"I")
.. I '$$ISACTIVE(EFF,EXP) Q
.. 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)
;
; Check for Railroad
I $G(^AUPNRRE(DFN,0))'="" D
. S INSCO=$$GET1^DIQ(9000005,DFN_",",.02,"E")
. S IEN=0
. F S IEN=$O(^AUPNRRE(DFN,11,IEN)) Q:'IEN D
.. NEW DA,IENS,EFF,EXP
.. S DA(1)=DFN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S EFF=$$GET1^DIQ(9000005.11,IENS,.01,"I")
.. S EXP=$$GET1^DIQ(9000005.11,IENS,.02,"I")
.. I '$$ISACTIVE(EFF,EXP) Q
.. 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)
;
; Check for Medicaid
S IEN=""
F S IEN=$O(^AUPNMCD("B",DFN,IEN)) Q:IEN="" D
. S INSCO=$$GET1^DIQ(9000004,IEN_",",.02,"E")
. S MN=0
. F S MN=$O(^AUPNMCD(IEN,11,MN)) Q:'MN D
.. NEW DA,IENS,EFF,EXP
.. S DA(1)=IEN,DA=MN,IENS=$$IENS^DILF(.DA)
.. S EFF=$$GET1^DIQ(9000004.11,IENS,.01,"I")
.. S EXP=$$GET1^DIQ(9000004.11,IENS,.02,"I")
.. I '$$ISACTIVE(EFF,EXP) Q
.. 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)
;
; Check for Private Insurance
N AGD S AGD=0
F S AGD=$O(^AUPNPRVT(DFN,11,AGD)) Q:'AGD D
. N DA,IENS,EFF,EXP,POLH,COV
. S DA(1)=DFN,DA=AGD,IENS=$$IENS^DILF(.DA)
. S EFF=$$GET1^DIQ(9000006.11,IENS,".06","I")
. S EXP=$$GET1^DIQ(9000006.11,IENS,".07","I")
. I '$$ISACTIVE(EFF,EXP) Q
. S POLH=$$GET1^DIQ(9000006.11,IENS,".08","I")
. S COV="" S:POLH]"" COV=$$GET1^DIQ(9000003.1,POLH_",",".05","E")
. S II=II+1,@DATA@(II)=$$GET1^DIQ(9000006.11,IENS,".01","E")_" "_COV_"^"_$$FMTE^BQIUL1(EFF)_$C(30)
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
LYO(DFN) ;EP - Layout display
NEW RESULT,INSCO,IEN,QFL,MN
; Check for Medicare
S RESULT=""
I $G(^AUPNMCR(DFN,0))'="" D
. S INSCO=$$GET1^DIQ(9000003,DFN_",",.02,"E")
. S IEN=0
. F S IEN=$O(^AUPNMCR(DFN,11,IEN)) Q:'IEN D
.. NEW DA,IENS,EFF,EXP
.. S DA(1)=DFN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S EFF=$$GET1^DIQ(9000003.11,IENS,.01,"I")
.. S EXP=$$GET1^DIQ(9000003.11,IENS,.02,"I")
.. I '$$ISACTIVE(EFF,EXP) Q
.. S RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000003.11,IENS,.03,"E")_"; "_$C(13)_$C(10)
;
; Check for Medicaid
S IEN="",QFL=0
F S IEN=$O(^AUPNMCD("B",DFN,IEN)) Q:IEN="" D Q:QFL
. S INSCO=$$GET1^DIQ(9000004,IEN_",",.02,"E")
. S MN=0
. F S MN=$O(^AUPNMCD(IEN,11,MN)) Q:'MN D
.. NEW DA,IENS,EFF,EXP
.. S DA(1)=IEN,DA=MN,IENS=$$IENS^DILF(.DA)
.. S EFF=$$GET1^DIQ(9000004.11,IENS,.01,"I")
.. S EXP=$$GET1^DIQ(9000004.11,IENS,.02,"I")
.. I '$$ISACTIVE(EFF,EXP) Q
.. S RESULT=RESULT_INSCO_"; "_$C(13)_$C(10),QFL=1
;
; Check for Railroad
I $G(^AUPNRRE(DFN,0))'="" D
. S INSCO=$$GET1^DIQ(9000005,DFN_",",.02,"E")
. S IEN=0
. F S IEN=$O(^AUPNRRE(DFN,11,IEN)) Q:'IEN D
.. NEW DA,IENS,EFF,EXP
.. S DA(1)=DFN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S EFF=$$GET1^DIQ(9000005.11,IENS,.01,"I")
.. S EXP=$$GET1^DIQ(9000005.11,IENS,.02,"I")
.. I '$$ISACTIVE(EFF,EXP) Q
.. S RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000005.11,IENS,.03,"E")_"; "_$C(13)_$C(10)
;
; Check for Private Insurance
S IEN=""
F S IEN=$O(^AUPN3PPH("C",DFN,IEN)) Q:IEN="" D
. ;I $$GET1^DIQ(9000003.1,IEN_",",.18,"I")'="" Q
. S EFF=$$GET1^DIQ(9000003.1,IEN,.17,"I")
. S EXP=$$GET1^DIQ(9000003.1,IEN,.18,"I")
. I '$$ISACTIVE(EFF,EXP) Q
. S INSCO=$$GET1^DIQ(9000003.1,IEN_",",.03,"E")
. S RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000003.1,IEN_",",.05,"E")_"; "_$C(13)_$C(10)
S RESULT=$$TKO^BQIUL1(RESULT,"; "_$C(13)_$C(10))
Q RESULT
;
ISACTIVE(EFFDT,ENDDT) ;EP - POL. ACTIVE TODAY?
N OPENEND
I EFFDT="",(ENDDT="") Q 0
S ENDDT=ENDDT
S OPENEND=ENDDT=""
I OPENEND I DT=EFFDT!(DT>EFFDT) Q 1
I DT=EFFDT!(DT=ENDDT) Q 1
I DT>EFFDT&(DT<ENDDT) Q 1
Q 0
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
+2 ;
+3 QUIT
+4 ;
GET(DATA,DFN) ; EP -- BQI PATIENT INSURANCE
+1 NEW UID,II,INSCO,X,INSCO,IEN,MN
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIPTINS",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTINS D UNWIND^%ZTER"
+8 ;
+9 SET @DATA@(II)="T00100INSURANCE_COVERAGE^D00015EFFECTIVE_DATE"_$CHAR(30)
+10 ;
+11 ; Check for Medicare
+12 IF $GET(^AUPNMCR(DFN,0))'=""
Begin DoDot:1
+13 SET INSCO=$$GET1^DIQ(9000003,DFN_",",.02,"E")
+14 SET IEN=0
+15 FOR
SET IEN=$ORDER(^AUPNMCR(DFN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+16 NEW DA,IENS,EFF,EXP
+17 SET DA(1)=DFN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+18 SET EFF=$$GET1^DIQ(9000003.11,IENS,.01,"I")
+19 SET EXP=$$GET1^DIQ(9000003.11,IENS,.02,"I")
+20 IF '$$ISACTIVE(EFF,EXP)
QUIT
+21 SET II=II+1
SET @DATA@(II)=INSCO_" "_$$GET1^DIQ(9000003.11,IENS,.03,"E")_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000003.11,IENS,.01,"I"))_$CHAR(30)
End DoDot:2
End DoDot:1
+22 ;
+23 ; Check for Railroad
+24 IF $GET(^AUPNRRE(DFN,0))'=""
Begin DoDot:1
+25 SET INSCO=$$GET1^DIQ(9000005,DFN_",",.02,"E")
+26 SET IEN=0
+27 FOR
SET IEN=$ORDER(^AUPNRRE(DFN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+28 NEW DA,IENS,EFF,EXP
+29 SET DA(1)=DFN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+30 SET EFF=$$GET1^DIQ(9000005.11,IENS,.01,"I")
+31 SET EXP=$$GET1^DIQ(9000005.11,IENS,.02,"I")
+32 IF '$$ISACTIVE(EFF,EXP)
QUIT
+33 SET II=II+1
SET @DATA@(II)=INSCO_" "_$$GET1^DIQ(9000005.11,IENS,.03,"E")_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000005.11,IENS,.01,"I"))_$CHAR(30)
End DoDot:2
End DoDot:1
+34 ;
+35 ; Check for Medicaid
+36 SET IEN=""
+37 FOR
SET IEN=$ORDER(^AUPNMCD("B",DFN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+38 SET INSCO=$$GET1^DIQ(9000004,IEN_",",.02,"E")
+39 SET MN=0
+40 FOR
SET MN=$ORDER(^AUPNMCD(IEN,11,MN))
IF 'MN
QUIT
Begin DoDot:2
+41 NEW DA,IENS,EFF,EXP
+42 SET DA(1)=IEN
SET DA=MN
SET IENS=$$IENS^DILF(.DA)
+43 SET EFF=$$GET1^DIQ(9000004.11,IENS,.01,"I")
+44 SET EXP=$$GET1^DIQ(9000004.11,IENS,.02,"I")
+45 IF '$$ISACTIVE(EFF,EXP)
QUIT
+46 SET II=II+1
SET @DATA@(II)=INSCO_" "_$$GET1^DIQ(9000004.11,IENS,.03,"E")_"^"_$$FMTE^BQIUL1($$GET1^DIQ(9000004.11,IENS,.01,"I"))_$CHAR(30)
End DoDot:2
End DoDot:1
+47 ;
+48 ; Check for Private Insurance
+49 NEW AGD
SET AGD=0
+50 FOR
SET AGD=$ORDER(^AUPNPRVT(DFN,11,AGD))
IF 'AGD
QUIT
Begin DoDot:1
+51 NEW DA,IENS,EFF,EXP,POLH,COV
+52 SET DA(1)=DFN
SET DA=AGD
SET IENS=$$IENS^DILF(.DA)
+53 SET EFF=$$GET1^DIQ(9000006.11,IENS,".06","I")
+54 SET EXP=$$GET1^DIQ(9000006.11,IENS,".07","I")
+55 IF '$$ISACTIVE(EFF,EXP)
QUIT
+56 SET POLH=$$GET1^DIQ(9000006.11,IENS,".08","I")
+57 SET COV=""
IF POLH]""
SET COV=$$GET1^DIQ(9000003.1,POLH_",",".05","E")
+58 SET II=II+1
SET @DATA@(II)=$$GET1^DIQ(9000006.11,IENS,".01","E")_" "_COV_"^"_$$FMTE^BQIUL1(EFF)_$CHAR(30)
End DoDot:1
+59 ;
+60 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+61 QUIT
+62 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
LYO(DFN) ;EP - Layout display
+1 NEW RESULT,INSCO,IEN,QFL,MN
+2 ; Check for Medicare
+3 SET RESULT=""
+4 IF $GET(^AUPNMCR(DFN,0))'=""
Begin DoDot:1
+5 SET INSCO=$$GET1^DIQ(9000003,DFN_",",.02,"E")
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(^AUPNMCR(DFN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+8 NEW DA,IENS,EFF,EXP
+9 SET DA(1)=DFN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+10 SET EFF=$$GET1^DIQ(9000003.11,IENS,.01,"I")
+11 SET EXP=$$GET1^DIQ(9000003.11,IENS,.02,"I")
+12 IF '$$ISACTIVE(EFF,EXP)
QUIT
+13 SET RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000003.11,IENS,.03,"E")_"; "_$CHAR(13)_$CHAR(10)
End DoDot:2
End DoDot:1
+14 ;
+15 ; Check for Medicaid
+16 SET IEN=""
SET QFL=0
+17 FOR
SET IEN=$ORDER(^AUPNMCD("B",DFN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+18 SET INSCO=$$GET1^DIQ(9000004,IEN_",",.02,"E")
+19 SET MN=0
+20 FOR
SET MN=$ORDER(^AUPNMCD(IEN,11,MN))
IF 'MN
QUIT
Begin DoDot:2
+21 NEW DA,IENS,EFF,EXP
+22 SET DA(1)=IEN
SET DA=MN
SET IENS=$$IENS^DILF(.DA)
+23 SET EFF=$$GET1^DIQ(9000004.11,IENS,.01,"I")
+24 SET EXP=$$GET1^DIQ(9000004.11,IENS,.02,"I")
+25 IF '$$ISACTIVE(EFF,EXP)
QUIT
+26 SET RESULT=RESULT_INSCO_"; "_$CHAR(13)_$CHAR(10)
SET QFL=1
End DoDot:2
End DoDot:1
IF QFL
QUIT
+27 ;
+28 ; Check for Railroad
+29 IF $GET(^AUPNRRE(DFN,0))'=""
Begin DoDot:1
+30 SET INSCO=$$GET1^DIQ(9000005,DFN_",",.02,"E")
+31 SET IEN=0
+32 FOR
SET IEN=$ORDER(^AUPNRRE(DFN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+33 NEW DA,IENS,EFF,EXP
+34 SET DA(1)=DFN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+35 SET EFF=$$GET1^DIQ(9000005.11,IENS,.01,"I")
+36 SET EXP=$$GET1^DIQ(9000005.11,IENS,.02,"I")
+37 IF '$$ISACTIVE(EFF,EXP)
QUIT
+38 SET RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000005.11,IENS,.03,"E")_"; "_$CHAR(13)_$CHAR(10)
End DoDot:2
End DoDot:1
+39 ;
+40 ; Check for Private Insurance
+41 SET IEN=""
+42 FOR
SET IEN=$ORDER(^AUPN3PPH("C",DFN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+43 ;I $$GET1^DIQ(9000003.1,IEN_",",.18,"I")'="" Q
+44 SET EFF=$$GET1^DIQ(9000003.1,IEN,.17,"I")
+45 SET EXP=$$GET1^DIQ(9000003.1,IEN,.18,"I")
+46 IF '$$ISACTIVE(EFF,EXP)
QUIT
+47 SET INSCO=$$GET1^DIQ(9000003.1,IEN_",",.03,"E")
+48 SET RESULT=RESULT_INSCO_" "_$$GET1^DIQ(9000003.1,IEN_",",.05,"E")_"; "_$CHAR(13)_$CHAR(10)
End DoDot:1
+49 SET RESULT=$$TKO^BQIUL1(RESULT,"; "_$CHAR(13)_$CHAR(10))
+50 QUIT RESULT
+51 ;
ISACTIVE(EFFDT,ENDDT) ;EP - POL. ACTIVE TODAY?
+1 NEW OPENEND
+2 IF EFFDT=""
IF (ENDDT="")
QUIT 0
+3 SET ENDDT=ENDDT
+4 SET OPENEND=ENDDT=""
+5 IF OPENEND
IF DT=EFFDT!(DT>EFFDT)
QUIT 1
+6 IF DT=EFFDT!(DT=ENDDT)
QUIT 1
+7 IF DT>EFFDT&(DT<ENDDT)
QUIT 1
+8 QUIT 0
