BLRRLHL ;cmi/anch/maw - BLR HL7 Utilities for Reference Lab ;27-Jul-2015 06:10;MKK
;;5.2;IHS LABORATORY;**1027,1028,1031,1034,1036**;NOV 01, 1997;Build 10
Q
;
CLIENT N BLRCLCNT
I +$G(BLRAGUI) Q $$CLIENTG^BLRRLEDI(LRORD,LRUID)
S BLRCLCNT=$$CLCNT(DUZ(2))
I $G(BLRCLCNT)=1 D
. S BLRRL("CLIENT")=$O(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RLCA","B",""))
. I $G(BLRRL("CLIENT"))="" S BLRRL("CLIENT")=$P($G(^BLRRL(BLRRL("RL"),0)),U,13)
I $G(BLRCLCNT)>1 D
. W !,"Please select the appropriate account number for this accession"
. N BLRRLD
. S BLRRLD=0 F S BLRRLD=$O(BLRCLA(BLRRLD)) Q:'BLRRLD D
.. W !,BLRRLD_") "_$G(BLRCLA(BLRRLD))
. K DIR
. S DIR(0)="N^1:"_$G(BLRCLCNT),DIR("A")="Which account number for this accession "
. D ^DIR
. Q:$D(DIRUT)
. S BLRRL("CLIENT")=$G(BLRCLA(+Y))
S BLRRLCLT=BLRRL("CLIENT")
I $G(BLRRL("CLIENT"))="" G CLIENT
S BLRRLCLA=BLRRLCLT
;cmi/maw 2/25/2008 end of mods for multiple account numbers
;cmi/maw 10/31/07 ask what type of billing here
;cmi/maw 10/31/07 end of mods
Q
;
CLCNT(DZ2) ;-- get the number of client account numbers to see if we need to prompt
N BLRRLDA,BLRCLC
S BLRCLC=0
S BLRRLDA=0 F S BLRRLDA=$O(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DZ2),"RLCA","B",BLRRLDA)) Q:BLRRLDA="" D
. S BLRCLC=BLRCLC+1
. S BLRCLA(BLRCLC)=BLRRLDA
Q +$G(BLRCLC)
;
BILL ;-- this is where we ask billing type
I '$G(BLRRLASK),BLRRLCNT>0 D Q
. I $E($G(BLRRLBTP),1,1)="P" D PATBILL(BLRTSTDA) Q
. Q:$E($G(BLRRLBTP),1,1)'="T"
. S BLRRL("BILL TYPE")="T"
. D SETINS
. ;D SETDX^BLRRLHL2 ;ihs/cmi/maw p1034
S DIR(0)="S^C:Client;T:Third Party;P:Patient"
S DIR("A")="Which Party is Responsible for Billing: "
S DIR("B")=$P($G(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RL")),U,15)
D ^DIR
; S BLRRL("BILL TYPE")=Y(0)
; I $D(DIRUT) S BLRRL("BILL TYPE")="Client"
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1036
I $D(DIRUT) S BLRRL("BILL TYPE")="Client"
E S BLRRL("BILL TYPE")=$G(Y(0))
; ----- END IHS/MSC/MKK - LR*5.2*1036
K DIR
I $E(BLRRL("BILL TYPE"),1,1)="T" D
. K DXCNT,INSCNT
. S DXCNT=1
. S INSCNT=1
. ;D DX^BLRRLEDI(LRORD) ;ihs/cmi/maw - LR*5.2*1034
. ;D DX2^BLRRLHL2(BLRRL("PAT")) ;ihs/cmi/maw - LR*5.2*1034
. D INS(BLRRL("PAT"),0)
;I $E(BLRRL("BILL TYPE"),1,1)="T",$G(BLRRL("DX"))="" D G BILL
I $E(BLRRL("BILL TYPE"),1,1)="T",'$O(^BLRRLO(BLRO,1,"B",0)) D G BILL ;ihs/cmi/maw p1034
. W !,"You must select an ICD Diagnosis if Bill Type is Third Party"
. D DX^BLRRLEDI(LRORD)
I $E(BLRRL("BILL TYPE"),1,1)="T",$G(BLRRL("INSE"))="" D G BILL
. W !,"You must select an Insurer if Bill Type is Third Party"
I $E(BLRRL("BILL TYPE"),1,1)="P" D PATBILL(BLRTSTDA)
S BLRRLCNT=BLRRLCNT+1
S BLRRLBTP=BLRRL("BILL TYPE")
Q
;
DX(PAT) ;-- get the diagnosis for billing
D DX2^BLRRLHL2(PAT) ; IHS/MSC/MKK - LR*5.2*1034
Q
;
INS(PAT,FLG) ;-- lets get a list of selectable insurances for the patient and if set for auto select pick the first one in sequence
;we must also setup the BLRRL insurance array and diagnosis array for GIS
S DFN=PAT
D ^AGINS
I '$D(AGINS(1)),$E($G(BLRRL("BILL TYPE")),1,1)="T" D Q ;p1034
. W !,"Patient has No Insurance on file, changing Bill Type to Client"
. S BLRRL("BILL TYPE")="Client"
. S BLRRL("INSCOV")=BLRRL("BILL TYPE")
;W !,"Now Applying Sequenced Insurer to Accession"
;cmi/maw 1/22/2010 readded ask of insurance if flag set for no sequencing
I $P($G(^BLRSITE($S($G(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RL")),U,21) D Q ;get flag for insurance
. I '$G(FLG) W !,"Now applying Sequenced Insurer to Accession"
. S BLRINS=1
. D SETINS
I $G(FLG) S BLRINS=1 G SETINS
N BLRRLDA,BLRRLCN
S BLRRLCN=0
S BLRRLDA=0 F S BLRRLDA=$O(AGINS(BLRRLDA)) Q:'BLRRLDA D
. S BLRRLCN=BLRRLCN+1
. W !,BLRRLCN_")"_$P(AGINS(BLRRLDA),U)
. W ?30,"Policy #: "_$P(AGINS(BLRRLDA),U,9)
. W ?50,"Elg/Exp Date: "_$S($P(AGINS(BLRRLDA),U,5)>0:$$FMTE^XLFDT($P(AGINS(BLRRLDA),U,5)),1:"")_"/"_$S($P(AGINS(BLRRLDA),U,6)>0:$$FMTE^XLFDT($P(AGINS(BLRRLDA),U,6)),1:"")
S DIR(0)="N^1:"_$G(BLRRLCN),DIR("A")="Select the insurer for this accession: "
D ^DIR
Q:$D(DIRUT)
Q:Y<0
S BLRINS=+Y
;cmi/maw 1/22/2010 end of add of ask of insurer
SETINS I '$G(PAT) S PAT=DFN
I $G(BLRRL(BLRTSTDA,"CDT")) S BLRRLCDT=BLRRL(BLRTSTDA,"CDT")
D SEQINS(.AGINS,PAT,$G(BLRRLCDT))
I '$D(BLRSEQ(1)) D Q
. W !,"Patient Insurance has not been Sequenced, changing Bill Type to Client"
. S BLRRL("BILL TYPE")="Client"
. S BLRRL("INSCOV")=BLRRL("BILL TYPE")
K AGINS
M AGINS=BLRSEQ
K BLRSEQ
S BLRINS=1
I '$G(FLG) D UPINS^BLRRLEDI(LRORD,LRUID,PAT,$TR(AGINS(BLRINS),"^","~")) ;ihs/cmi/maw p1034
S BLRRL(BLRTSTDA,"INSE")=$P(AGINS(BLRINS),U)
S BLRRL("INSE")=$P(AGINS(BLRINS),U)
S BLRRL(BLRTSTDA,"INSI")=$P(AGINS(BLRINS),U,2)
I '$G(BLRRL(BLRTSTDA,"INSI")) D Q
. W !,"The entry for "_$G(BLRRL("INSE"))_" for this patient does not have a valid pointer to the INSURER file, this needs to be fixed to proceed"
. S BLRRL("BILL TYPE")="Patient"
. S BLRRL("INSCOV")=BLRRL("BILL TYPE")
S BLRRL(BLRTSTDA,"INSCOV")=$E($G(BLRRL("BILL TYPE")),1,1)
S BLRRL(BLRTSTDA,"INSPH")=$P(AGINS(BLRINS),U,7)
S BLRRL(BLRTSTDA,"INSGRP")=$P(AGINS(BLRINS),U,20)
S BLRRL(BLRTSTDA,"INSREL")=$S($P(AGINS(BLRINS),U,16):$P($G(^AUTTRLSH($P(AGINS(BLRINS),U,16),0)),U),1:"")
S BLRRL(BLRTSTDA,"INSRELE")=BLRRL(BLRTSTDA,"INSREL")
I $G(BLRRL(BLRTSTDA,"INSREL"))]"" D
. I BLRRL(BLRTSTDA,"INSREL")="SELF" S BLRRL(BLRTSTDA,"INSREL")=$S(BLRRL("RLE")["QUEST":2,1:1) Q
. I BLRRL(BLRTSTDA,"INSREL")="SPOUSE" S BLRRL(BLRTSTDA,"INSREL")=$S(BLRRL("RLE")["QUEST":2,1:2),BLRRL(BLRTSTDA,"INSRELE")="SPOUSE" Q
. I BLRRL(BLRTSTDA,"INSREL")="HUSBAND" S BLRRL(BLRTSTDA,"INSREL")=$S(BLRRL("RLE")["QUEST":2,1:2),BLRRL(BLRTSTDA,"INSRELE")="SPOUSE" Q
. I BLRRL(BLRTSTDA,"INSREL")="WIFE" S BLRRL(BLRTSTDA,"INSREL")=$S(BLRRL("RLE")["QUEST":2,1:2),BLRRL(BLRTSTDA,"INSRELE")="SPOUSE" Q
. S BLRRL(BLRTSTDA,"INSREL")=$S(BLRRL("RLE")["QUEST":8,1:3),BLRRL(BLRTSTDA,"INSRELE")="OTHER" Q
I $G(BLRRL(BLRTSTDA,"INSREL"))="" S BLRRL(BLRTSTDA,"INSREL")=$S(BLRRL("RLE")["QUEST":1,1:1),BLRRL(BLRTSTDA,"INSRELE")="SELF"
S BLRRL(BLRTSTDA,"INSPOL")=$P(AGINS(BLRINS),U,9)
S BLRRL(BLRTSTDA,"INSELG")=$P(AGINS(BLRINS),U,5)
S BLRRL(BLRTSTDA,"INSEXP")=$P(AGINS(BLRINS),U,6)
S BLRRL(BLRTSTDA,"INSPLN")=$S(BLRRL(BLRTSTDA,"INSE")["MEDICARE":"MC",BLRRL(BLRTSTDA,"INSE")["MEDICAID":"MD",1:"PI")
S BLRRL(BLRTSTDA,"INSTYP")=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
I BLRRL(BLRTSTDA,"INSI")]"" D
. ;S BLRRL(BLRTSTDA,"INSID")=$TR($P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U,10),"~") ;cmi/maw 2/17/2009 changed to piece 10 external group name from external id 2
. S BLRRL(BLRTSTDA,"INSID")=$TR($P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U,19),"~") ;cmi/maw 2/17/2009 changed to piece 19 external ID 3
. S BLRRL(BLRTSTDA,"INSCNME")=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),0)),U) ;insurance company name
. S BLRRL(BLRTSTDA,"INSADD")=$$INSADD(BLRRL(BLRTSTDA,"INSI"))
. S BLRRL(BLRTSTDA,"INSADDE")=$TR($P(BLRRL(BLRTSTDA,"INSADD"),U),U," ")_"~"_$TR($P(BLRRL(BLRTSTDA,"INSADD"),U,3,99),U," ")
. S BLRRL(BLRTSTDA,"INSPHO")=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),0)),U,6)
. S BLRRL(BLRTSTDA,"INSTYP")=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
S BLRRL(BLRTSTDA,"PATADD")=$$PATADD(PAT)
S BLRRL(BLRTSTDA,"PATADDE")=$TR($P($$PATADD(PAT),U),U," ")_"~"_$TR($P($$PATADD(PAT),U,3,99),U," ")
S BLRRL(BLRTSTDA,"INSEMP")=$$GET1^DIQ(2,PAT,.3111)
S BLRRL(BLRTSTDA,"INSNOI")=$$HLNAME^XLFNAME($P(^DPT(PAT,0),U))
S BLRRL(BLRTSTDA,"INSNOIE")=$P(^DPT(PAT,0),U)
;next set of lines for hl7 in1 segments
D HL7
S BLRRL(BLRTSTDA,"GT1PHI")=$P(AGINS(BLRINS),U,7)
I $E(BLRRL(BLRTSTDA,"GT1PHI"),1,1)="P" D Q
. S BLRRL(BLRTSTDA,"GT1NM")=$$HLNAME^XLFNAME($P(^AUPN3PPH($E(BLRRL(BLRTSTDA,"GT1PHI"),2,99),0),U))
. S BLRRL(BLRTSTDA,"GT1ADD")=$$GT1ADD($E(BLRRL(BLRTSTDA,"GT1PHI"),2,99))
. S BLRRL(BLRTSTDA,"GT1PHO")=$P($G(^AUPN3PPH($E(BLRRL(BLRTSTDA,"GT1PHI"),2,99),0)),U,14)
. D INSTYP(BLRTSTDA)
. S BLRRL(BLRTSTDA,"GT1ADDE")=$TR($P($G(BLRRL(BLRTSTDA,"GT1ADD")),U),U," ")_"~"_$TR($P($G(BLRRL(BLRTSTDA,"GT1ADD")),U,3,99),U," ")
. S BLRRL(BLRTSTDA,"GT1NME")=$TR($G(BLRRL(BLRTSTDA,"GT1NM")),U," ")
I BLRRL(BLRTSTDA,"GT1PHI")]"" D
. S BLRRL(BLRTSTDA,"GT1NM")=$$HLNAME^XLFNAME($P(^DPT(PAT,0),U))
. S BLRRL(BLRTSTDA,"GT1ADD")=$$PATADD(PAT)
. S BLRRL(BLRTSTDA,"GT1PHO")=$P($G(^DPT(PAT,.131)),U)
I $G(BLRRL(BLRTSTDA,"GT1NM"))="" D
. S BLRRL(BLRTSTDA,"GT1NM")=BLRRL(BLRTSTDA,"INSNOI")
. S BLRRL(BLRTSTDA,"GT1ADD")=BLRRL(BLRTSTDA,"PATADD")
D INSTYP(BLRTSTDA)
S BLRRL(BLRTSTDA,"GT1ADDE")=$TR($P($G(BLRRL(BLRTSTDA,"GT1ADD")),U),U," ")_"~"_$TR($P($G(BLRRL(BLRTSTDA,"GT1ADD")),U,3,99),U," ")
S BLRRL(BLRTSTDA,"GT1NME")=$TR($G(BLRRL(BLRTSTDA,"GT1NM")),U," ")
Q
;
INSTYP(TDA) ;-- get insurance type
I $G(BLRRL(TDA,"INSTYP"))]"" D
. I BLRRL(TDA,"INSTYP")="H" S BLRRL(TDA,"INSTYP")="HMO"
. I BLRRL(TDA,"INSTYP")="MD" S BLRRL(TDA,"INSTYP")="Medicare"
. I BLRRL(TDA,"INSTYP")="M" S BLRRL(TDA,"INSTYP")="Medicare"
. I BLRRL(TDA,"INSTYP")="P" S BLRRL(TDA,"INSTYP")="Private Insurance"
. I BLRRL(TDA,"INSTYP")="D" S BLRRL(TDA,"INSTYP")="Medicaid"
. I BLRRL(TDA,"INSTYP")="R" S BLRRL(TDA,"INSTYP")="Medicare"
. I BLRRL(TDA,"INSTYP")="MH" S BLRRL(TDA,"INSTYP")="Medicaid"
I $G(BLRRL(TDA,"INSTYP"))="" S BLRRL(TDA,"INSTYP")="Private Insurance"
S BLRRL("INSTYP")=$G(BLRRL(TDA,"INSTYP"))
Q
;
PATBILL(TSTDA) ;-- return data for the patient bill
S BLRRL(TSTDA,"GT1NM")=$$HLNAME^XLFNAME($P(^DPT(BLRRL("PAT"),0),U))
S BLRRL(TSTDA,"GT1NME")=$P(^DPT(BLRRL("PAT"),0),U)
S BLRRL(TSTDA,"GT1ADD")=$$PATADD(BLRRL("PAT"))
S BLRRL(TSTDA,"GT1ADDE")=$TR($P($$PATADD(BLRRL("PAT")),U),U," ")_"~"_$TR($P($$PATADD(BLRRL("PAT")),U,3,99),U," ")
S BLRRL(TSTDA,"GT1PHO")=$P($G(^DPT(BLRRL("PAT"),.13)),U)
S BLRRL(TSTDA,"INSCOV")="P"
S BLRRL("INSE")="Patient Bill"
Q
;
INSADD(INSI) ;-- return the insurance address is HL7 format
N ADD,DATA,STR,CTY,ST,ZIP
S DATA=$G(^AUTNINS(INSI,0))
S STR=$P(DATA,U,2)
S CTY=$P(DATA,U,3)
S ST=$S($P(DATA,U,4):$P($G(^DIC(5,$P(DATA,U,4),0)),U,2),1:"")
S ZIP=$P(DATA,U,5)
S ADD=STR_U_U_CTY_U_ST_U_ZIP
Q ADD
;
PATADD(PAT) ;-- return insured address
N ADD,DATA,STR,CTY,ST,ZIP
S DATA=$G(^DPT(PAT,.11))
S STR=$P(DATA,U)
S CTY=$P(DATA,U,4)
S ST=$S($P(DATA,U,5):$P($G(^DIC(5,$P(DATA,U,5),0)),U,2),1:"")
S ZIP=$P(DATA,U,6)
S ADD=STR_U_U_CTY_U_ST_U_ZIP
Q ADD
;
GT1ADD(PH) ;-- return insured address
N ADD,DATA,STR,CTY,ST,ZIP
S DATA=$G(^AUPN3PPH(PH,0))
S STR=$P(DATA,U,9)
S CTY=$P(DATA,U,11)
S ST=$S($P(DATA,U,12):$P($G(^DIC(5,$P(DATA,U,12),0)),U,2),1:"")
S ZIP=$P(DATA,U,13)
S ADD=STR_U_U_CTY_U_ST_U_ZIP
Q ADD
;
HL7 ;-- setup hl7 lines
N HLDA
S HLDA=0 F S HLDA=$O(AGINS(HLDA)) Q:'HLDA D
. ; D HLSET(HLDA)
. D HLSET^BLRRLHL2(HLDA) ; IHS/MSC/MKK - LR*5.2*1034
Q
;
;
SEQINS(BINS,PT,RLCDT) ;-- lets go through sequencing insurers
Q:'$O(BINS(""))
N BDA
S BDA=0 F S BDA=$O(BINS(BDA)) Q:'BDA D
. N BINI,SEQ,POLI
. S BINI=$P(BINS(BDA),U,2)
. S POLI=$P(BINS(BDA),U,9)
. S SEQ=$$FNDSEQ(BINI,PT,POLI,RLCDT)
. Q:'SEQ
. S BLRSEQ(SEQ)=$G(BINS(BDA))
Q
;
FNDSEQ(BN,PTI,POL,CDT) ;-- find the category prioritization
N SQDA,EFF,SQPRI
S EFF=$O(^AUPNICP("EFF",PTI,"M",CDT),-1)
I '$G(EFF) Q ""
S SQDA=0 F S SQDA=$O(^AUPNICP("EFF",PTI,"M",EFF,SQDA)) Q:'SQDA!($G(SQPRI)) D
. N SQDATA,SQPAT,SQPOL,SQINS
. S SQDATA=$G(^AUPNICP(SQDA,0))
. S SQPAT=$P(SQDATA,U,2)
. S SQINS=$P(SQDATA,U,3)
. S SQPOL=$P(SQDATA,U,10)
. Q:SQPAT'=PTI
. Q:SQINS'=BN
. Q:SQPOL'=POL
. S SQPRI=$P(SQDATA,U,5)
Q $G(SQPRI)
;
BLRRLHL ;cmi/anch/maw - BLR HL7 Utilities for Reference Lab ;27-Jul-2015 06:10;MKK
+1 ;;5.2;IHS LABORATORY;**1027,1028,1031,1034,1036**;NOV 01, 1997;Build 10
+2 QUIT
+3 ;
CLIENT NEW BLRCLCNT
+1 IF +$GET(BLRAGUI)
QUIT $$CLIENTG^BLRRLEDI(LRORD,LRUID)
+2 SET BLRCLCNT=$$CLCNT(DUZ(2))
+3 IF $GET(BLRCLCNT)=1
Begin DoDot:1
+4 SET BLRRL("CLIENT")=$ORDER(^BLRSITE($SELECT($GET(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RLCA","B",""))
+5 IF $GET(BLRRL("CLIENT"))=""
SET BLRRL("CLIENT")=$PIECE($GET(^BLRRL(BLRRL("RL"),0)),U,13)
End DoDot:1
+6 IF $GET(BLRCLCNT)>1
Begin DoDot:1
+7 WRITE !,"Please select the appropriate account number for this accession"
+8 NEW BLRRLD
+9 SET BLRRLD=0
FOR
SET BLRRLD=$ORDER(BLRCLA(BLRRLD))
IF 'BLRRLD
QUIT
Begin DoDot:2
+10 WRITE !,BLRRLD_") "_$GET(BLRCLA(BLRRLD))
End DoDot:2
+11 KILL DIR
+12 SET DIR(0)="N^1:"_$GET(BLRCLCNT)
SET DIR("A")="Which account number for this accession "
+13 DO ^DIR
+14 IF $DATA(DIRUT)
QUIT
+15 SET BLRRL("CLIENT")=$GET(BLRCLA(+Y))
End DoDot:1
+16 SET BLRRLCLT=BLRRL("CLIENT")
+17 IF $GET(BLRRL("CLIENT"))=""
GOTO CLIENT
+18 SET BLRRLCLA=BLRRLCLT
+19 ;cmi/maw 2/25/2008 end of mods for multiple account numbers
+20 ;cmi/maw 10/31/07 ask what type of billing here
+21 ;cmi/maw 10/31/07 end of mods
+22 QUIT
+23 ;
CLCNT(DZ2) ;-- get the number of client account numbers to see if we need to prompt
+1 NEW BLRRLDA,BLRCLC
+2 SET BLRCLC=0
+3 SET BLRRLDA=0
FOR
SET BLRRLDA=$ORDER(^BLRSITE($SELECT($GET(BLRALTDZ):BLRALTDZ,1:DZ2),"RLCA","B",BLRRLDA))
IF BLRRLDA=""
QUIT
Begin DoDot:1
+4 SET BLRCLC=BLRCLC+1
+5 SET BLRCLA(BLRCLC)=BLRRLDA
End DoDot:1
+6 QUIT +$GET(BLRCLC)
+7 ;
BILL ;-- this is where we ask billing type
+1 IF '$GET(BLRRLASK)
IF BLRRLCNT>0
Begin DoDot:1
+2 IF $EXTRACT($GET(BLRRLBTP),1,1)="P"
DO PATBILL(BLRTSTDA)
QUIT
+3 IF $EXTRACT($GET(BLRRLBTP),1,1)'="T"
QUIT
+4 SET BLRRL("BILL TYPE")="T"
+5 DO SETINS
+6 ;D SETDX^BLRRLHL2 ;ihs/cmi/maw p1034
End DoDot:1
QUIT
+7 SET DIR(0)="S^C:Client;T:Third Party;P:Patient"
+8 SET DIR("A")="Which Party is Responsible for Billing: "
+9 SET DIR("B")=$PIECE($GET(^BLRSITE($SELECT($GET(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RL")),U,15)
+10 DO ^DIR
+11 ; S BLRRL("BILL TYPE")=Y(0)
+12 ; I $D(DIRUT) S BLRRL("BILL TYPE")="Client"
+13 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1036
+14 IF $DATA(DIRUT)
SET BLRRL("BILL TYPE")="Client"
+15 IF '$TEST
SET BLRRL("BILL TYPE")=$GET(Y(0))
+16 ; ----- END IHS/MSC/MKK - LR*5.2*1036
+17 KILL DIR
+18 IF $EXTRACT(BLRRL("BILL TYPE"),1,1)="T"
Begin DoDot:1
+19 KILL DXCNT,INSCNT
+20 SET DXCNT=1
+21 SET INSCNT=1
+22 ;D DX^BLRRLEDI(LRORD) ;ihs/cmi/maw - LR*5.2*1034
+23 ;D DX2^BLRRLHL2(BLRRL("PAT")) ;ihs/cmi/maw - LR*5.2*1034
+24 DO INS(BLRRL("PAT"),0)
End DoDot:1
+25 ;I $E(BLRRL("BILL TYPE"),1,1)="T",$G(BLRRL("DX"))="" D G BILL
+26 ;ihs/cmi/maw p1034
IF $EXTRACT(BLRRL("BILL TYPE"),1,1)="T"
IF '$ORDER(^BLRRLO(BLRO,1,"B",0))
Begin DoDot:1
+27 WRITE !,"You must select an ICD Diagnosis if Bill Type is Third Party"
+28 DO DX^BLRRLEDI(LRORD)
End DoDot:1
GOTO BILL
+29 IF $EXTRACT(BLRRL("BILL TYPE"),1,1)="T"
IF $GET(BLRRL("INSE"))=""
Begin DoDot:1
+30 WRITE !,"You must select an Insurer if Bill Type is Third Party"
End DoDot:1
GOTO BILL
+31 IF $EXTRACT(BLRRL("BILL TYPE"),1,1)="P"
DO PATBILL(BLRTSTDA)
+32 SET BLRRLCNT=BLRRLCNT+1
+33 SET BLRRLBTP=BLRRL("BILL TYPE")
+34 QUIT
+35 ;
DX(PAT) ;-- get the diagnosis for billing
+1 ; IHS/MSC/MKK - LR*5.2*1034
DO DX2^BLRRLHL2(PAT)
+2 QUIT
+3 ;
INS(PAT,FLG) ;-- lets get a list of selectable insurances for the patient and if set for auto select pick the first one in sequence
+1 ;we must also setup the BLRRL insurance array and diagnosis array for GIS
+2 SET DFN=PAT
+3 DO ^AGINS
+4 ;p1034
IF '$DATA(AGINS(1))
IF $EXTRACT($GET(BLRRL("BILL TYPE")),1,1)="T"
Begin DoDot:1
+5 WRITE !,"Patient has No Insurance on file, changing Bill Type to Client"
+6 SET BLRRL("BILL TYPE")="Client"
+7 SET BLRRL("INSCOV")=BLRRL("BILL TYPE")
End DoDot:1
QUIT
+8 ;W !,"Now Applying Sequenced Insurer to Accession"
+9 ;cmi/maw 1/22/2010 readded ask of insurance if flag set for no sequencing
+10 ;get flag for insurance
IF $PIECE($GET(^BLRSITE($SELECT($GET(BLRALTDZ):BLRALTDZ,1:DUZ(2)),"RL")),U,21)
Begin DoDot:1
+11 IF '$GET(FLG)
WRITE !,"Now applying Sequenced Insurer to Accession"
+12 SET BLRINS=1
+13 DO SETINS
End DoDot:1
QUIT
+14 IF $GET(FLG)
SET BLRINS=1
GOTO SETINS
+15 NEW BLRRLDA,BLRRLCN
+16 SET BLRRLCN=0
+17 SET BLRRLDA=0
FOR
SET BLRRLDA=$ORDER(AGINS(BLRRLDA))
IF 'BLRRLDA
QUIT
Begin DoDot:1
+18 SET BLRRLCN=BLRRLCN+1
+19 WRITE !,BLRRLCN_")"_$PIECE(AGINS(BLRRLDA),U)
+20 WRITE ?30,"Policy #: "_$PIECE(AGINS(BLRRLDA),U,9)
+21 WRITE ?50,"Elg/Exp Date: "_$SELECT($PIECE(AGINS(BLRRLDA),U,5)>0:$$FMTE^XLFDT($PIECE(AGINS(BLRRLDA),U,5)),1:"")_"/"_$SELECT($PIECE(AGINS(BLRRLDA),U,6)>0:$$FMTE^XLFDT($PIECE(AGINS(BLRRLDA),U,6)),1:"")
End DoDot:1
+22 SET DIR(0)="N^1:"_$GET(BLRRLCN)
SET DIR("A")="Select the insurer for this accession: "
+23 DO ^DIR
+24 IF $DATA(DIRUT)
QUIT
+25 IF Y<0
QUIT
+26 SET BLRINS=+Y
+27 ;cmi/maw 1/22/2010 end of add of ask of insurer
SETINS IF '$GET(PAT)
SET PAT=DFN
+1 IF $GET(BLRRL(BLRTSTDA,"CDT"))
SET BLRRLCDT=BLRRL(BLRTSTDA,"CDT")
+2 DO SEQINS(.AGINS,PAT,$GET(BLRRLCDT))
+3 IF '$DATA(BLRSEQ(1))
Begin DoDot:1
+4 WRITE !,"Patient Insurance has not been Sequenced, changing Bill Type to Client"
+5 SET BLRRL("BILL TYPE")="Client"
+6 SET BLRRL("INSCOV")=BLRRL("BILL TYPE")
End DoDot:1
QUIT
+7 KILL AGINS
+8 MERGE AGINS=BLRSEQ
+9 KILL BLRSEQ
+10 SET BLRINS=1
+11 ;ihs/cmi/maw p1034
IF '$GET(FLG)
DO UPINS^BLRRLEDI(LRORD,LRUID,PAT,$TRANSLATE(AGINS(BLRINS),"^","~"))
+12 SET BLRRL(BLRTSTDA,"INSE")=$PIECE(AGINS(BLRINS),U)
+13 SET BLRRL("INSE")=$PIECE(AGINS(BLRINS),U)
+14 SET BLRRL(BLRTSTDA,"INSI")=$PIECE(AGINS(BLRINS),U,2)
+15 IF '$GET(BLRRL(BLRTSTDA,"INSI"))
Begin DoDot:1
+16 WRITE !,"The entry for "_$GET(BLRRL("INSE"))_" for this patient does not have a valid pointer to the INSURER file, this needs to be fixed to proceed"
+17 SET BLRRL("BILL TYPE")="Patient"
+18 SET BLRRL("INSCOV")=BLRRL("BILL TYPE")
End DoDot:1
QUIT
+19 SET BLRRL(BLRTSTDA,"INSCOV")=$EXTRACT($GET(BLRRL("BILL TYPE")),1,1)
+20 SET BLRRL(BLRTSTDA,"INSPH")=$PIECE(AGINS(BLRINS),U,7)
+21 SET BLRRL(BLRTSTDA,"INSGRP")=$PIECE(AGINS(BLRINS),U,20)
+22 SET BLRRL(BLRTSTDA,"INSREL")=$SELECT($PIECE(AGINS(BLRINS),U,16):$PIECE($GET(^AUTTRLSH($PIECE(AGINS(BLRINS),U,16),0)),U),1:"")
+23 SET BLRRL(BLRTSTDA,"INSRELE")=BLRRL(BLRTSTDA,"INSREL")
+24 IF $GET(BLRRL(BLRTSTDA,"INSREL"))]""
Begin DoDot:1
+25 IF BLRRL(BLRTSTDA,"INSREL")="SELF"
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":2,1:1)
QUIT
+26 IF BLRRL(BLRTSTDA,"INSREL")="SPOUSE"
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE")="SPOUSE"
QUIT
+27 IF BLRRL(BLRTSTDA,"INSREL")="HUSBAND"
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE")="SPOUSE"
QUIT
+28 IF BLRRL(BLRTSTDA,"INSREL")="WIFE"
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE")="SPOUSE"
QUIT
+29 SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":8,1:3)
SET BLRRL(BLRTSTDA,"INSRELE")="OTHER"
QUIT
End DoDot:1
+30 IF $GET(BLRRL(BLRTSTDA,"INSREL"))=""
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":1,1:1)
SET BLRRL(BLRTSTDA,"INSRELE")="SELF"
+31 SET BLRRL(BLRTSTDA,"INSPOL")=$PIECE(AGINS(BLRINS),U,9)
+32 SET BLRRL(BLRTSTDA,"INSELG")=$PIECE(AGINS(BLRINS),U,5)
+33 SET BLRRL(BLRTSTDA,"INSEXP")=$PIECE(AGINS(BLRINS),U,6)
+34 SET BLRRL(BLRTSTDA,"INSPLN")=$SELECT(BLRRL(BLRTSTDA,"INSE")["MEDICARE":"MC",BLRRL(BLRTSTDA,"INSE")["MEDICAID":"MD",1:"PI")
+35 SET BLRRL(BLRTSTDA,"INSTYP")=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
+36 IF BLRRL(BLRTSTDA,"INSI")]""
Begin DoDot:1
+37 ;S BLRRL(BLRTSTDA,"INSID")=$TR($P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U,10),"~") ;cmi/maw 2/17/2009 changed to piece 10 external group name from external id 2
+38 ;cmi/maw 2/17/2009 changed to piece 19 external ID 3
SET BLRRL(BLRTSTDA,"INSID")=$TRANSLATE($PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U,19),"~")
+39 ;insurance company name
SET BLRRL(BLRTSTDA,"INSCNME")=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),0)),U)
+40 SET BLRRL(BLRTSTDA,"INSADD")=$$INSADD(BLRRL(BLRTSTDA,"INSI"))
+41 SET BLRRL(BLRTSTDA,"INSADDE")=$TRANSLATE($PIECE(BLRRL(BLRTSTDA,"INSADD"),U),U," ")_"~"_$TRANSLATE($PIECE(BLRRL(BLRTSTDA,"INSADD"),U,3,99),U," ")
+42 SET BLRRL(BLRTSTDA,"INSPHO")=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),0)),U,6)
+43 SET BLRRL(BLRTSTDA,"INSTYP")=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
End DoDot:1
+44 SET BLRRL(BLRTSTDA,"PATADD")=$$PATADD(PAT)
+45 SET BLRRL(BLRTSTDA,"PATADDE")=$TRANSLATE($PIECE($$PATADD(PAT),U),U," ")_"~"_$TRANSLATE($PIECE($$PATADD(PAT),U,3,99),U," ")
+46 SET BLRRL(BLRTSTDA,"INSEMP")=$$GET1^DIQ(2,PAT,.3111)
+47 SET BLRRL(BLRTSTDA,"INSNOI")=$$HLNAME^XLFNAME($PIECE(^DPT(PAT,0),U))
+48 SET BLRRL(BLRTSTDA,"INSNOIE")=$PIECE(^DPT(PAT,0),U)
+49 ;next set of lines for hl7 in1 segments
+50 DO HL7
+51 SET BLRRL(BLRTSTDA,"GT1PHI")=$PIECE(AGINS(BLRINS),U,7)
+52 IF $EXTRACT(BLRRL(BLRTSTDA,"GT1PHI"),1,1)="P"
Begin DoDot:1
+53 SET BLRRL(BLRTSTDA,"GT1NM")=$$HLNAME^XLFNAME($PIECE(^AUPN3PPH($EXTRACT(BLRRL(BLRTSTDA,"GT1PHI"),2,99),0),U))
+54 SET BLRRL(BLRTSTDA,"GT1ADD")=$$GT1ADD($EXTRACT(BLRRL(BLRTSTDA,"GT1PHI"),2,99))
+55 SET BLRRL(BLRTSTDA,"GT1PHO")=$PIECE($GET(^AUPN3PPH($EXTRACT(BLRRL(BLRTSTDA,"GT1PHI"),2,99),0)),U,14)
+56 DO INSTYP(BLRTSTDA)
+57 SET BLRRL(BLRTSTDA,"GT1ADDE")=$TRANSLATE($PIECE($GET(BLRRL(BLRTSTDA,"GT1ADD")),U),U," ")_"~"_$TRANSLATE($PIECE($GET(BLRRL(BLRTSTDA,"GT1ADD")),U,3,99),U," ")
+58 SET BLRRL(BLRTSTDA,"GT1NME")=$TRANSLATE($GET(BLRRL(BLRTSTDA,"GT1NM")),U," ")
End DoDot:1
QUIT
+59 IF BLRRL(BLRTSTDA,"GT1PHI")]""
Begin DoDot:1
+60 SET BLRRL(BLRTSTDA,"GT1NM")=$$HLNAME^XLFNAME($PIECE(^DPT(PAT,0),U))
+61 SET BLRRL(BLRTSTDA,"GT1ADD")=$$PATADD(PAT)
+62 SET BLRRL(BLRTSTDA,"GT1PHO")=$PIECE($GET(^DPT(PAT,.131)),U)
End DoDot:1
+63 IF $GET(BLRRL(BLRTSTDA,"GT1NM"))=""
Begin DoDot:1
+64 SET BLRRL(BLRTSTDA,"GT1NM")=BLRRL(BLRTSTDA,"INSNOI")
+65 SET BLRRL(BLRTSTDA,"GT1ADD")=BLRRL(BLRTSTDA,"PATADD")
End DoDot:1
+66 DO INSTYP(BLRTSTDA)
+67 SET BLRRL(BLRTSTDA,"GT1ADDE")=$TRANSLATE($PIECE($GET(BLRRL(BLRTSTDA,"GT1ADD")),U),U," ")_"~"_$TRANSLATE($PIECE($GET(BLRRL(BLRTSTDA,"GT1ADD")),U,3,99),U," ")
+68 SET BLRRL(BLRTSTDA,"GT1NME")=$TRANSLATE($GET(BLRRL(BLRTSTDA,"GT1NM")),U," ")
+69 QUIT
+70 ;
INSTYP(TDA) ;-- get insurance type
+1 IF $GET(BLRRL(TDA,"INSTYP"))]""
Begin DoDot:1
+2 IF BLRRL(TDA,"INSTYP")="H"
SET BLRRL(TDA,"INSTYP")="HMO"
+3 IF BLRRL(TDA,"INSTYP")="MD"
SET BLRRL(TDA,"INSTYP")="Medicare"
+4 IF BLRRL(TDA,"INSTYP")="M"
SET BLRRL(TDA,"INSTYP")="Medicare"
+5 IF BLRRL(TDA,"INSTYP")="P"
SET BLRRL(TDA,"INSTYP")="Private Insurance"
+6 IF BLRRL(TDA,"INSTYP")="D"
SET BLRRL(TDA,"INSTYP")="Medicaid"
+7 IF BLRRL(TDA,"INSTYP")="R"
SET BLRRL(TDA,"INSTYP")="Medicare"
+8 IF BLRRL(TDA,"INSTYP")="MH"
SET BLRRL(TDA,"INSTYP")="Medicaid"
End DoDot:1
+9 IF $GET(BLRRL(TDA,"INSTYP"))=""
SET BLRRL(TDA,"INSTYP")="Private Insurance"
+10 SET BLRRL("INSTYP")=$GET(BLRRL(TDA,"INSTYP"))
+11 QUIT
+12 ;
PATBILL(TSTDA) ;-- return data for the patient bill
+1 SET BLRRL(TSTDA,"GT1NM")=$$HLNAME^XLFNAME($PIECE(^DPT(BLRRL("PAT"),0),U))
+2 SET BLRRL(TSTDA,"GT1NME")=$PIECE(^DPT(BLRRL("PAT"),0),U)
+3 SET BLRRL(TSTDA,"GT1ADD")=$$PATADD(BLRRL("PAT"))
+4 SET BLRRL(TSTDA,"GT1ADDE")=$TRANSLATE($PIECE($$PATADD(BLRRL("PAT")),U),U," ")_"~"_$TRANSLATE($PIECE($$PATADD(BLRRL("PAT")),U,3,99),U," ")
+5 SET BLRRL(TSTDA,"GT1PHO")=$PIECE($GET(^DPT(BLRRL("PAT"),.13)),U)
+6 SET BLRRL(TSTDA,"INSCOV")="P"
+7 SET BLRRL("INSE")="Patient Bill"
+8 QUIT
+9 ;
INSADD(INSI) ;-- return the insurance address is HL7 format
+1 NEW ADD,DATA,STR,CTY,ST,ZIP
+2 SET DATA=$GET(^AUTNINS(INSI,0))
+3 SET STR=$PIECE(DATA,U,2)
+4 SET CTY=$PIECE(DATA,U,3)
+5 SET ST=$SELECT($PIECE(DATA,U,4):$PIECE($GET(^DIC(5,$PIECE(DATA,U,4),0)),U,2),1:"")
+6 SET ZIP=$PIECE(DATA,U,5)
+7 SET ADD=STR_U_U_CTY_U_ST_U_ZIP
+8 QUIT ADD
+9 ;
PATADD(PAT) ;-- return insured address
+1 NEW ADD,DATA,STR,CTY,ST,ZIP
+2 SET DATA=$GET(^DPT(PAT,.11))
+3 SET STR=$PIECE(DATA,U)
+4 SET CTY=$PIECE(DATA,U,4)
+5 SET ST=$SELECT($PIECE(DATA,U,5):$PIECE($GET(^DIC(5,$PIECE(DATA,U,5),0)),U,2),1:"")
+6 SET ZIP=$PIECE(DATA,U,6)
+7 SET ADD=STR_U_U_CTY_U_ST_U_ZIP
+8 QUIT ADD
+9 ;
GT1ADD(PH) ;-- return insured address
+1 NEW ADD,DATA,STR,CTY,ST,ZIP
+2 SET DATA=$GET(^AUPN3PPH(PH,0))
+3 SET STR=$PIECE(DATA,U,9)
+4 SET CTY=$PIECE(DATA,U,11)
+5 SET ST=$SELECT($PIECE(DATA,U,12):$PIECE($GET(^DIC(5,$PIECE(DATA,U,12),0)),U,2),1:"")
+6 SET ZIP=$PIECE(DATA,U,13)
+7 SET ADD=STR_U_U_CTY_U_ST_U_ZIP
+8 QUIT ADD
+9 ;
HL7 ;-- setup hl7 lines
+1 NEW HLDA
+2 SET HLDA=0
FOR
SET HLDA=$ORDER(AGINS(HLDA))
IF 'HLDA
QUIT
Begin DoDot:1
+3 ; D HLSET(HLDA)
+4 ; IHS/MSC/MKK - LR*5.2*1034
DO HLSET^BLRRLHL2(HLDA)
End DoDot:1
+5 QUIT
+6 ;
+7 ;
SEQINS(BINS,PT,RLCDT) ;-- lets go through sequencing insurers
+1 IF '$ORDER(BINS(""))
QUIT
+2 NEW BDA
+3 SET BDA=0
FOR
SET BDA=$ORDER(BINS(BDA))
IF 'BDA
QUIT
Begin DoDot:1
+4 NEW BINI,SEQ,POLI
+5 SET BINI=$PIECE(BINS(BDA),U,2)
+6 SET POLI=$PIECE(BINS(BDA),U,9)
+7 SET SEQ=$$FNDSEQ(BINI,PT,POLI,RLCDT)
+8 IF 'SEQ
QUIT
+9 SET BLRSEQ(SEQ)=$GET(BINS(BDA))
End DoDot:1
+10 QUIT
+11 ;
FNDSEQ(BN,PTI,POL,CDT) ;-- find the category prioritization
+1 NEW SQDA,EFF,SQPRI
+2 SET EFF=$ORDER(^AUPNICP("EFF",PTI,"M",CDT),-1)
+3 IF '$GET(EFF)
QUIT ""
+4 SET SQDA=0
FOR
SET SQDA=$ORDER(^AUPNICP("EFF",PTI,"M",EFF,SQDA))
IF 'SQDA!($GET(SQPRI))
QUIT
Begin DoDot:1
+5 NEW SQDATA,SQPAT,SQPOL,SQINS
+6 SET SQDATA=$GET(^AUPNICP(SQDA,0))
+7 SET SQPAT=$PIECE(SQDATA,U,2)
+8 SET SQINS=$PIECE(SQDATA,U,3)
+9 SET SQPOL=$PIECE(SQDATA,U,10)
+10 IF SQPAT'=PTI
QUIT
+11 IF SQINS'=BN
QUIT
+12 IF SQPOL'=POL
QUIT
+13 SET SQPRI=$PIECE(SQDATA,U,5)
End DoDot:1
+14 QUIT $GET(SQPRI)
+15 ;
