BLRRLHL.m

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))