BLRAG05C ; IHS/MSC/SAT - SUPPORT FOR LABORATORY ACCESSION GUI RPCS ; 17-Oct-2014 09:22 ; MKK
;;5.2;IHS LABORATORY;**1031,1034,1039**;NOV 01, 1997;Build 38
Q
;
BILL ;-- this is where we ask billing type
Q:$G(BLRRL("BILL TYPE"))'="T"
D SETINS
F BLRJK=1:1:$L(BLRAGDX,":") D
.S BLRADX=0
.; S BLRDXS=$$ICDDX^ICDCODE($P(BLRAGDX,":",BLRJK))
.S BLRDXS=$$ICDDX^ICDEX($P(BLRAGDX,":",BLRJK),,,"I") ; IHS/MSC/MKK - LR*5.2*1034
.D SETDX
Q
;
DX(PAT) ;-- get the diagnosis for billing
K DIC,BLRDXS,BLRADX,BLRDXA
;
S BLRADX=1
;
; S DIC="^ICD9("
; S DIC("S")="I '$P($G(^(0)),U,9)"
; S DIC(0)="AEMQZ",DIC("A")="What is the ICD Diagnosis code for billing: "
; D ^DIC
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
; AICD 4.0 re-structured File 80. There is no longer an INACTIVE FLAG.
; STATUS is now a multiple. Note that STATUS=1 is ACTIVE; STATUS=0 is INACTIVE.
; This means the D ^DIC call will no longer work: have to use D ^DIR.
NEW ICD10DT,ICD10PTR
;
D ^XBFMK
;
; Try to use 80.4 to determine ICD-10 Date
S ICD10PTR=+$$FIND1^DIC(80.4,,,"ICD-10-CM")
S ICD10DT=+$P($$GET1^DIQ(80.4,ICD10PTR,"IMPLEMENTATION DATE","I"),".")
S:ICD10DT<1 ICD10DT=3151001 ; If no ICD10DT, hard set to 10/1/2015.
;
; If Date >= ICD-10 date, just return ACTIVE ICD-9 & ICD-10 entries
I $$DT^XLFDT>=ICD10DT S DIR("S")="I $P($G(^ICD9(+Y,66,+$O(^ICD9(+Y,66,""A""),-1),0)),""^"",2)"
;
; If Date < ICD-10 date, only ICD-9 AND ACTIVE entries are returned
I $$DT^XLFDT<ICD10DT S DIR("S")="I +$G(^ICD9(+Y,1))<30&($P($G(^ICD9(+Y,66,+$O(^ICD9(+Y,66,""A""),-1),0)),""^"",2))"
;
S DIR(0)="PO^80:AEMQZ"
S DIR("A")="What is the ICD Diagnosis code for billing: "
D ^DIR
; ----- END IHS/MSC/MKK - LR*5.2*1034
;
I Y<0 D Q
. D ADDDX(BLRTSTDA)
. K BLRADX
;
; S BLRDXS=$$ICDDX^ICDCODE(+Y)
S BLRDXS=$$ICDDX^ICDEX(+Y,,,"I") ; IHS/MSC/MKK - LR*5.2*1034
I $G(BLRDXA(+Y)) D G ENDDX
. W !,"You have already selected this Diagnosis"
S BLRDXA(+Y)=1
S BLRDX(DXCNT)=BLRDXS
SETDX I '$G(BLRADX) D ADDDX(BLRTSTDA) Q
;S BLRRL(BLRTSTDA,"DX",DXCNT)=$P(BLRDXS,U,2)
S BLRRL("DX",DXCNT)=$P(BLRDXS,U,2)
S BLRRL("DX")=$P(BLRDXS,U,2)
;S BLRRL(BLRTSTDA,"DXE",DXCNT)=$P(BLRDXS,U,4)
S DXCNT=DXCNT+1
ENDDX D DX(BLRRL("PAT"))
Q
;
ADDDX(TSTDA) ;-- add the diagnosis to the test since it is not there, this happens when they want all dx for mult accessions
N TDA
S TDA=0 F S TDA=$O(BLRDX(TDA)) Q:'TDA D
. N DXS
. S DXS=$G(BLRDX(TDA))
. S BLRRL(TSTDA,"DX",TDA)=$P(DXS,U,2)
. S BLRRL(TSTDA,"DXE",TDA)=$P(DXS,U,4)
. S BLRRL(TSTDA,"DX")=$P(DXS,U,2) ;cmi/maw 01/20/2010
. S BLRRL(TSTDA,"DXE")=$P(DXS,U,4) ;cmi/maw 01/20/2010
Q
;
SETINS I '$G(PAT) S PAT=DFN
I $G(BLRRL(BLRTSTDA,"CDT")) S BLRRLCDT=BLRRL(BLRTSTDA,"CDT")
;D SEQINS(.AGINS,PAT,$G(BLRRLCDT))
I 0&'$D(BLRSEQ(1)) D Q
. ; W !,"Patient Insurance has not been Sequenced, changing Bill Type to Patient"
. S BLRRL("BILL TYPE")="Patient"
. S BLRRL("INSCOV")=BLRRL("BILL TYPE")
;K AGINS
;M AGINS=BLRSEQ
;K BLRSEQ
S BLRINS=1
S BLRRL(BLRTSTDA,"INSE")=$P(BLRAGINS,U)
S BLRRL("INSE")=$P(BLRAGINS,U)
S BLRRL(BLRTSTDA,"INSI")=$P(BLRAGINS,U,2)
I 0&'$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(BLRAGINS,U,7)
S BLRRL(BLRTSTDA,"INSGRP")=$P(BLRAGINS,U,20)
S BLRRL(BLRTSTDA,"INSREL")=$S($P(BLRAGINS,U,16):$P($G(^AUTTRLSH($P(BLRAGINS,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(BLRAGINS,U,9)
S BLRRL(BLRTSTDA,"INSELG")=$P(BLRAGINS,U,5)
S BLRRL(BLRTSTDA,"INSEXP")=$P(BLRAGINS,U,6)
; S BLRRL(BLRTSTDA,"INSPLN")=$S(BLRRL(BLRTSTDA,"INSE")["MEDICARE":"MC",BLRRL(BLRTSTDA,"INSE")["MEDICAID":"MD",1:"PI")
S BLRRL(BLRTSTDA,"INSPLN")=$S($G(BLRRL(BLRTSTDA,"INSE"))["MEDICARE":"MC",$G(BLRRL(BLRTSTDA,"INSE"))["MEDICAID":"MD",1:"PI") ; IHS/MSC/MKK - LR*5.2*1039
; S BLRRL(BLRTSTDA,"INSTYP")=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
S BLRRL(BLRTSTDA,"INSTYP")=$P($G(^AUTNINS(+$G(BLRRL(BLRTSTDA,"INSI")),2)),U) ; IHS/MSC/MKK - LR*5.2*1039
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(BLRRL("PAT")),U),U," ")_"~"_$TR($P($$PATADD(BLRRL("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(BLRAGINS,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
;
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)
Q
;
HLSET(BLRINS) ;-- setup hl7 variables
S INSCNT=BLRINS
S BLRRL(BLRTSTDA,"INSE",INSCNT)=$P(BLRAGINS,U)
S BLRRL("INSE",INSCNT)=$P(BLRAGINS,U)
S BLRRL(BLRTSTDA,"INSI",INSCNT)=$P(BLRAGINS,U,2)
;S BLRRL(BLRTSTDA,"INSCOV")=$P(BLRAGINS,U,4)
S BLRRL(BLRTSTDA,"INSCOV",INSCNT)=$E($G(BLRRL("BILL TYPE")),1,1)
S BLRRL(BLRTSTDA,"INSPH",INSCNT)=$P(BLRAGINS,U,7)
S BLRRL(BLRTSTDA,"INSGRP",INSCNT)=$P(BLRAGINS,U,20)
S BLRRL(BLRTSTDA,"INSREL",INSCNT)=$S($P(BLRAGINS,U,16):$P($G(^AUTTRLSH($P(BLRAGINS,U,16),0)),U),1:"")
S BLRRL(BLRTSTDA,"INSRELE",INSCNT)=BLRRL(BLRTSTDA,"INSREL",INSCNT)
I $G(BLRRL(BLRTSTDA,"INSREL",INSCNT))]"" D
. I BLRRL(BLRTSTDA,"INSREL",INSCNT)="SELF" S BLRRL(BLRTSTDA,"INSREL",INSCNT)=$S(BLRRL("RLE")["QUEST":2,1:1) Q
. I BLRRL(BLRTSTDA,"INSREL",INSCNT)="SPOUSE" S BLRRL(BLRTSTDA,"INSREL",INSCNT)=$S(BLRRL("RLE")["QUEST":2,1:2),BLRRL(BLRTSTDA,"INSRELE",INSCNT)="SPOUSE" Q
. I BLRRL(BLRTSTDA,"INSREL",INSCNT)="HUSBAND" S BLRRL(BLRTSTDA,"INSREL",INSCNT)=$S(BLRRL("RLE")["QUEST":2,1:2),BLRRL(BLRTSTDA,"INSRELE",INSCNT)="SPOUSE" Q
. I BLRRL(BLRTSTDA,"INSREL",INSCNT)="WIFE" S BLRRL(BLRTSTDA,"INSREL",INSCNT)=$S(BLRRL("RLE")["QUEST":2,1:2),BLRRL(BLRTSTDA,"INSRELE",INSCNT)="SPOUSE" Q
. S BLRRL(BLRTSTDA,"INSREL",INSCNT)=$S(BLRRL("RLE")["QUEST":8,1:3),BLRRL(BLRTSTDA,"INSRELE",INSCNT)="OTHER" Q
I $G(BLRRL(BLRTSTDA,"INSREL",INSCNT))="" S BLRRL(BLRTSTDA,"INSREL",INSCNT)=$S(BLRRL("RLE")["QUEST":1,1:1),BLRRL(BLRTSTDA,"INSRELE",INSCNT)="SELF"
S BLRRL(BLRTSTDA,"INSPOL",INSCNT)=$P(BLRAGINS,U,9)
S BLRRL(BLRTSTDA,"INSELG",INSCNT)=$P(BLRAGINS,U,5)
S BLRRL(BLRTSTDA,"INSEXP",INSCNT)=$P(BLRAGINS,U,6)
S BLRRL(BLRTSTDA,"INSPLN",INSCNT)=$S(BLRRL(BLRTSTDA,"INSE",INSCNT)["MEDICARE":"MC",BLRRL(BLRTSTDA,"INSE",INSCNT)["MEDICAID":"MD",1:"PI")
; S BLRRL(BLRTSTDA,"INSTYP",INSCNT)=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI",INSCNT),2)),U)
S BLRRL(BLRTSTDA,"INSTYP",INSCNT)=$P($G(^AUTNINS(+$G(BLRRL(BLRTSTDA,"INSI",INSCNT)),2)),U) ; IHS/MSC/MKK - LR*5.2*1039
; I BLRRL(BLRTSTDA,"INSI",INSCNT)]"" D
I $G(BLRRL(BLRTSTDA,"INSI",INSCNT))]"" D ; IHS/MSC/MKK - LR*5.2*1039
. S BLRRL(BLRTSTDA,"INSID",INSCNT)=$TR($P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI",INSCNT),2)),U,19),"~") ;cmi/maw 2/17/2009 changed to piece 10 external group name from external id 2
. S BLRRL(BLRTSTDA,"INSCNME",INSCNT)=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI",INSCNT),0)),U) ;insurance company name
. S BLRRL(BLRTSTDA,"INSADD",INSCNT)=$$INSADD(BLRRL(BLRTSTDA,"INSI",INSCNT))
. S BLRRL(BLRTSTDA,"INSADDE",INSCNT)=$TR($P(BLRRL(BLRTSTDA,"INSADD",INSCNT),U),U," ")_"~"_$TR($P(BLRRL(BLRTSTDA,"INSADD",INSCNT),U,3,99),U," ")
. S BLRRL(BLRTSTDA,"INSPHO",INSCNT)=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),0)),U,6)
. S BLRRL(BLRTSTDA,"INSTYP",INSCNT)=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
S BLRRL(BLRTSTDA,"INSEMP",INSCNT)=$$GET1^DIQ(2,PAT,.3111)
S BLRRL(BLRTSTDA,"INSNOI",INSCNT)=$$HLNAME^XLFNAME($P(^DPT(PAT,0),U))
S BLRRL(BLRTSTDA,"INSNOIE",INSCNT)=$P(^DPT(PAT,0),U)
S INSCNT=INSCNT+1
;end of hl7 lines
Q
BLRAG05C ; IHS/MSC/SAT - SUPPORT FOR LABORATORY ACCESSION GUI RPCS ; 17-Oct-2014 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1031,1034,1039**;NOV 01, 1997;Build 38
+2 QUIT
+3 ;
BILL ;-- this is where we ask billing type
+1 IF $GET(BLRRL("BILL TYPE"))'="T"
QUIT
+2 DO SETINS
+3 FOR BLRJK=1:1:$LENGTH(BLRAGDX,":")
Begin DoDot:1
+4 SET BLRADX=0
+5 ; S BLRDXS=$$ICDDX^ICDCODE($P(BLRAGDX,":",BLRJK))
+6 ; IHS/MSC/MKK - LR*5.2*1034
SET BLRDXS=$$ICDDX^ICDEX($PIECE(BLRAGDX,":",BLRJK),,,"I")
+7 DO SETDX
End DoDot:1
+8 QUIT
+9 ;
DX(PAT) ;-- get the diagnosis for billing
+1 KILL DIC,BLRDXS,BLRADX,BLRDXA
+2 ;
+3 SET BLRADX=1
+4 ;
+5 ; S DIC="^ICD9("
+6 ; S DIC("S")="I '$P($G(^(0)),U,9)"
+7 ; S DIC(0)="AEMQZ",DIC("A")="What is the ICD Diagnosis code for billing: "
+8 ; D ^DIC
+9 ;
+10 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
+11 ; AICD 4.0 re-structured File 80. There is no longer an INACTIVE FLAG.
+12 ; STATUS is now a multiple. Note that STATUS=1 is ACTIVE; STATUS=0 is INACTIVE.
+13 ; This means the D ^DIC call will no longer work: have to use D ^DIR.
+14 NEW ICD10DT,ICD10PTR
+15 ;
+16 DO ^XBFMK
+17 ;
+18 ; Try to use 80.4 to determine ICD-10 Date
+19 SET ICD10PTR=+$$FIND1^DIC(80.4,,,"ICD-10-CM")
+20 SET ICD10DT=+$PIECE($$GET1^DIQ(80.4,ICD10PTR,"IMPLEMENTATION DATE","I"),".")
+21 ; If no ICD10DT, hard set to 10/1/2015.
IF ICD10DT<1
SET ICD10DT=3151001
+22 ;
+23 ; If Date >= ICD-10 date, just return ACTIVE ICD-9 & ICD-10 entries
+24 IF $$DT^XLFDT>=ICD10DT
SET DIR("S")="I $P($G(^ICD9(+Y,66,+$O(^ICD9(+Y,66,""A""),-1),0)),""^"",2)"
+25 ;
+26 ; If Date < ICD-10 date, only ICD-9 AND ACTIVE entries are returned
+27 IF $$DT^XLFDT<ICD10DT
SET DIR("S")="I +$G(^ICD9(+Y,1))<30&($P($G(^ICD9(+Y,66,+$O(^ICD9(+Y,66,""A""),-1),0)),""^"",2))"
+28 ;
+29 SET DIR(0)="PO^80:AEMQZ"
+30 SET DIR("A")="What is the ICD Diagnosis code for billing: "
+31 DO ^DIR
+32 ; ----- END IHS/MSC/MKK - LR*5.2*1034
+33 ;
+34 IF Y<0
Begin DoDot:1
+35 DO ADDDX(BLRTSTDA)
+36 KILL BLRADX
End DoDot:1
QUIT
+37 ;
+38 ; S BLRDXS=$$ICDDX^ICDCODE(+Y)
+39 ; IHS/MSC/MKK - LR*5.2*1034
SET BLRDXS=$$ICDDX^ICDEX(+Y,,,"I")
+40 IF $GET(BLRDXA(+Y))
Begin DoDot:1
+41 WRITE !,"You have already selected this Diagnosis"
End DoDot:1
GOTO ENDDX
+42 SET BLRDXA(+Y)=1
+43 SET BLRDX(DXCNT)=BLRDXS
SETDX IF '$GET(BLRADX)
DO ADDDX(BLRTSTDA)
QUIT
+1 ;S BLRRL(BLRTSTDA,"DX",DXCNT)=$P(BLRDXS,U,2)
+2 SET BLRRL("DX",DXCNT)=$PIECE(BLRDXS,U,2)
+3 SET BLRRL("DX")=$PIECE(BLRDXS,U,2)
+4 ;S BLRRL(BLRTSTDA,"DXE",DXCNT)=$P(BLRDXS,U,4)
+5 SET DXCNT=DXCNT+1
ENDDX DO DX(BLRRL("PAT"))
+1 QUIT
+2 ;
ADDDX(TSTDA) ;-- add the diagnosis to the test since it is not there, this happens when they want all dx for mult accessions
+1 NEW TDA
+2 SET TDA=0
FOR
SET TDA=$ORDER(BLRDX(TDA))
IF 'TDA
QUIT
Begin DoDot:1
+3 NEW DXS
+4 SET DXS=$GET(BLRDX(TDA))
+5 SET BLRRL(TSTDA,"DX",TDA)=$PIECE(DXS,U,2)
+6 SET BLRRL(TSTDA,"DXE",TDA)=$PIECE(DXS,U,4)
+7 ;cmi/maw 01/20/2010
SET BLRRL(TSTDA,"DX")=$PIECE(DXS,U,2)
+8 ;cmi/maw 01/20/2010
SET BLRRL(TSTDA,"DXE")=$PIECE(DXS,U,4)
End DoDot:1
+9 QUIT
+10 ;
SETINS IF '$GET(PAT)
SET PAT=DFN
+1 IF $GET(BLRRL(BLRTSTDA,"CDT"))
SET BLRRLCDT=BLRRL(BLRTSTDA,"CDT")
+2 ;D SEQINS(.AGINS,PAT,$G(BLRRLCDT))
+3 IF 0&'$DATA(BLRSEQ(1))
Begin DoDot:1
+4 ; W !,"Patient Insurance has not been Sequenced, changing Bill Type to Patient"
+5 SET BLRRL("BILL TYPE")="Patient"
+6 SET BLRRL("INSCOV")=BLRRL("BILL TYPE")
End DoDot:1
QUIT
+7 ;K AGINS
+8 ;M AGINS=BLRSEQ
+9 ;K BLRSEQ
+10 SET BLRINS=1
+11 SET BLRRL(BLRTSTDA,"INSE")=$PIECE(BLRAGINS,U)
+12 SET BLRRL("INSE")=$PIECE(BLRAGINS,U)
+13 SET BLRRL(BLRTSTDA,"INSI")=$PIECE(BLRAGINS,U,2)
+14 IF 0&'$GET(BLRRL(BLRTSTDA,"INSI"))
Begin DoDot:1
+15 ; 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"
+16 SET BLRRL("BILL TYPE")="Patient"
+17 SET BLRRL("INSCOV")=BLRRL("BILL TYPE")
End DoDot:1
QUIT
+18 SET BLRRL(BLRTSTDA,"INSCOV")=$EXTRACT($GET(BLRRL("BILL TYPE")),1,1)
+19 SET BLRRL(BLRTSTDA,"INSPH")=$PIECE(BLRAGINS,U,7)
+20 SET BLRRL(BLRTSTDA,"INSGRP")=$PIECE(BLRAGINS,U,20)
+21 SET BLRRL(BLRTSTDA,"INSREL")=$SELECT($PIECE(BLRAGINS,U,16):$PIECE($GET(^AUTTRLSH($PIECE(BLRAGINS,U,16),0)),U),1:"")
+22 SET BLRRL(BLRTSTDA,"INSRELE")=BLRRL(BLRTSTDA,"INSREL")
+23 IF $GET(BLRRL(BLRTSTDA,"INSREL"))]""
Begin DoDot:1
+24 IF BLRRL(BLRTSTDA,"INSREL")="SELF"
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":2,1:1)
QUIT
+25 IF BLRRL(BLRTSTDA,"INSREL")="SPOUSE"
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE")="SPOUSE"
QUIT
+26 IF BLRRL(BLRTSTDA,"INSREL")="HUSBAND"
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE")="SPOUSE"
QUIT
+27 IF BLRRL(BLRTSTDA,"INSREL")="WIFE"
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE")="SPOUSE"
QUIT
+28 SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":8,1:3)
SET BLRRL(BLRTSTDA,"INSRELE")="OTHER"
QUIT
End DoDot:1
+29 IF $GET(BLRRL(BLRTSTDA,"INSREL"))=""
SET BLRRL(BLRTSTDA,"INSREL")=$SELECT(BLRRL("RLE")["QUEST":1,1:1)
SET BLRRL(BLRTSTDA,"INSRELE")="SELF"
+30 SET BLRRL(BLRTSTDA,"INSPOL")=$PIECE(BLRAGINS,U,9)
+31 SET BLRRL(BLRTSTDA,"INSELG")=$PIECE(BLRAGINS,U,5)
+32 SET BLRRL(BLRTSTDA,"INSEXP")=$PIECE(BLRAGINS,U,6)
+33 ; S BLRRL(BLRTSTDA,"INSPLN")=$S(BLRRL(BLRTSTDA,"INSE")["MEDICARE":"MC",BLRRL(BLRTSTDA,"INSE")["MEDICAID":"MD",1:"PI")
+34 ; IHS/MSC/MKK - LR*5.2*1039
SET BLRRL(BLRTSTDA,"INSPLN")=$SELECT($GET(BLRRL(BLRTSTDA,"INSE"))["MEDICARE":"MC",$GET(BLRRL(BLRTSTDA,"INSE"))["MEDICAID":"MD",1:"PI")
+35 ; S BLRRL(BLRTSTDA,"INSTYP")=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
+36 ; IHS/MSC/MKK - LR*5.2*1039
SET BLRRL(BLRTSTDA,"INSTYP")=$PIECE($GET(^AUTNINS(+$GET(BLRRL(BLRTSTDA,"INSI")),2)),U)
+37 IF BLRRL(BLRTSTDA,"INSI")]""
Begin DoDot:1
+38 ;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
+39 ;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),"~")
+40 ;insurance company name
SET BLRRL(BLRTSTDA,"INSCNME")=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),0)),U)
+41 SET BLRRL(BLRTSTDA,"INSADD")=$$INSADD(BLRRL(BLRTSTDA,"INSI"))
+42 SET BLRRL(BLRTSTDA,"INSADDE")=$TRANSLATE($PIECE(BLRRL(BLRTSTDA,"INSADD"),U),U," ")_"~"_$TRANSLATE($PIECE(BLRRL(BLRTSTDA,"INSADD"),U,3,99),U," ")
+43 SET BLRRL(BLRTSTDA,"INSPHO")=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),0)),U,6)
+44 SET BLRRL(BLRTSTDA,"INSTYP")=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
End DoDot:1
+45 SET BLRRL(BLRTSTDA,"PATADD")=$$PATADD(PAT)
+46 SET BLRRL(BLRTSTDA,"PATADDE")=$TRANSLATE($PIECE($$PATADD(BLRRL("PAT")),U),U," ")_"~"_$TRANSLATE($PIECE($$PATADD(BLRRL("PAT")),U,3,99),U," ")
+47 SET BLRRL(BLRTSTDA,"INSEMP")=$$GET1^DIQ(2,PAT,.3111)
+48 SET BLRRL(BLRTSTDA,"INSNOI")=$$HLNAME^XLFNAME($PIECE(^DPT(PAT,0),U))
+49 SET BLRRL(BLRTSTDA,"INSNOIE")=$PIECE(^DPT(PAT,0),U)
+50 ;next set of lines for hl7 in1 segments
+51 DO HL7
+52 SET BLRRL(BLRTSTDA,"GT1PHI")=$PIECE(BLRAGINS,U,7)
+53 IF $EXTRACT(BLRRL(BLRTSTDA,"GT1PHI"),1,1)="P"
Begin DoDot:1
+54 SET BLRRL(BLRTSTDA,"GT1NM")=$$HLNAME^XLFNAME($PIECE(^AUPN3PPH($EXTRACT(BLRRL(BLRTSTDA,"GT1PHI"),2,99),0),U))
+55 SET BLRRL(BLRTSTDA,"GT1ADD")=$$GT1ADD($EXTRACT(BLRRL(BLRTSTDA,"GT1PHI"),2,99))
+56 SET BLRRL(BLRTSTDA,"GT1PHO")=$PIECE($GET(^AUPN3PPH($EXTRACT(BLRRL(BLRTSTDA,"GT1PHI"),2,99),0)),U,14)
+57 DO INSTYP(BLRTSTDA)
+58 SET BLRRL(BLRTSTDA,"GT1ADDE")=$TRANSLATE($PIECE($GET(BLRRL(BLRTSTDA,"GT1ADD")),U),U," ")_"~"_$TRANSLATE($PIECE($GET(BLRRL(BLRTSTDA,"GT1ADD")),U,3,99),U," ")
+59 SET BLRRL(BLRTSTDA,"GT1NME")=$TRANSLATE($GET(BLRRL(BLRTSTDA,"GT1NM")),U," ")
End DoDot:1
QUIT
+60 IF BLRRL(BLRTSTDA,"GT1PHI")
Begin DoDot:1
+61 SET BLRRL(BLRTSTDA,"GT1NM")=$$HLNAME^XLFNAME($PIECE(^DPT(PAT,0),U))
+62 SET BLRRL(BLRTSTDA,"GT1ADD")=$$PATADD(PAT)
+63 SET BLRRL(BLRTSTDA,"GT1PHO")=$PIECE($GET(^DPT(PAT,.131)),U)
End DoDot:1
+64 IF $GET(BLRRL(BLRTSTDA,"GT1NM"))=""
Begin DoDot:1
+65 SET BLRRL(BLRTSTDA,"GT1NM")=BLRRL(BLRTSTDA,"INSNOI")
+66 SET BLRRL(BLRTSTDA,"GT1ADD")=BLRRL(BLRTSTDA,"PATADD")
End DoDot:1
+67 DO INSTYP(BLRTSTDA)
+68 SET BLRRL(BLRTSTDA,"GT1ADDE")=$TRANSLATE($PIECE($GET(BLRRL(BLRTSTDA,"GT1ADD")),U),U," ")_"~"_$TRANSLATE($PIECE($GET(BLRRL(BLRTSTDA,"GT1ADD")),U,3,99),U," ")
+69 SET BLRRL(BLRTSTDA,"GT1NME")=$TRANSLATE($GET(BLRRL(BLRTSTDA,"GT1NM")),U," ")
+70 QUIT
+71 ;
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 ;
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 DO HLSET(HLDA)
End DoDot:1
+4 QUIT
+5 ;
HLSET(BLRINS) ;-- setup hl7 variables
+1 SET INSCNT=BLRINS
+2 SET BLRRL(BLRTSTDA,"INSE",INSCNT)=$PIECE(BLRAGINS,U)
+3 SET BLRRL("INSE",INSCNT)=$PIECE(BLRAGINS,U)
+4 SET BLRRL(BLRTSTDA,"INSI",INSCNT)=$PIECE(BLRAGINS,U,2)
+5 ;S BLRRL(BLRTSTDA,"INSCOV")=$P(BLRAGINS,U,4)
+6 SET BLRRL(BLRTSTDA,"INSCOV",INSCNT)=$EXTRACT($GET(BLRRL("BILL TYPE")),1,1)
+7 SET BLRRL(BLRTSTDA,"INSPH",INSCNT)=$PIECE(BLRAGINS,U,7)
+8 SET BLRRL(BLRTSTDA,"INSGRP",INSCNT)=$PIECE(BLRAGINS,U,20)
+9 SET BLRRL(BLRTSTDA,"INSREL",INSCNT)=$SELECT($PIECE(BLRAGINS,U,16):$PIECE($GET(^AUTTRLSH($PIECE(BLRAGINS,U,16),0)),U),1:"")
+10 SET BLRRL(BLRTSTDA,"INSRELE",INSCNT)=BLRRL(BLRTSTDA,"INSREL",INSCNT)
+11 IF $GET(BLRRL(BLRTSTDA,"INSREL",INSCNT))]""
Begin DoDot:1
+12 IF BLRRL(BLRTSTDA,"INSREL",INSCNT)="SELF"
SET BLRRL(BLRTSTDA,"INSREL",INSCNT)=$SELECT(BLRRL("RLE")["QUEST":2,1:1)
QUIT
+13 IF BLRRL(BLRTSTDA,"INSREL",INSCNT)="SPOUSE"
SET BLRRL(BLRTSTDA,"INSREL",INSCNT)=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE",INSCNT)="SPOUSE"
QUIT
+14 IF BLRRL(BLRTSTDA,"INSREL",INSCNT)="HUSBAND"
SET BLRRL(BLRTSTDA,"INSREL",INSCNT)=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE",INSCNT)="SPOUSE"
QUIT
+15 IF BLRRL(BLRTSTDA,"INSREL",INSCNT)="WIFE"
SET BLRRL(BLRTSTDA,"INSREL",INSCNT)=$SELECT(BLRRL("RLE")["QUEST":2,1:2)
SET BLRRL(BLRTSTDA,"INSRELE",INSCNT)="SPOUSE"
QUIT
+16 SET BLRRL(BLRTSTDA,"INSREL",INSCNT)=$SELECT(BLRRL("RLE")["QUEST":8,1:3)
SET BLRRL(BLRTSTDA,"INSRELE",INSCNT)="OTHER"
QUIT
End DoDot:1
+17 IF $GET(BLRRL(BLRTSTDA,"INSREL",INSCNT))=""
SET BLRRL(BLRTSTDA,"INSREL",INSCNT)=$SELECT(BLRRL("RLE")["QUEST":1,1:1)
SET BLRRL(BLRTSTDA,"INSRELE",INSCNT)="SELF"
+18 SET BLRRL(BLRTSTDA,"INSPOL",INSCNT)=$PIECE(BLRAGINS,U,9)
+19 SET BLRRL(BLRTSTDA,"INSELG",INSCNT)=$PIECE(BLRAGINS,U,5)
+20 SET BLRRL(BLRTSTDA,"INSEXP",INSCNT)=$PIECE(BLRAGINS,U,6)
+21 SET BLRRL(BLRTSTDA,"INSPLN",INSCNT)=$SELECT(BLRRL(BLRTSTDA,"INSE",INSCNT)["MEDICARE":"MC",BLRRL(BLRTSTDA,"INSE",INSCNT)["MEDICAID":"MD",1:"PI")
+22 ; S BLRRL(BLRTSTDA,"INSTYP",INSCNT)=$P($G(^AUTNINS(BLRRL(BLRTSTDA,"INSI",INSCNT),2)),U)
+23 ; IHS/MSC/MKK - LR*5.2*1039
SET BLRRL(BLRTSTDA,"INSTYP",INSCNT)=$PIECE($GET(^AUTNINS(+$GET(BLRRL(BLRTSTDA,"INSI",INSCNT)),2)),U)
+24 ; I BLRRL(BLRTSTDA,"INSI",INSCNT)]"" D
+25 ; IHS/MSC/MKK - LR*5.2*1039
IF $GET(BLRRL(BLRTSTDA,"INSI",INSCNT))]""
Begin DoDot:1
+26 ;cmi/maw 2/17/2009 changed to piece 10 external group name from external id 2
SET BLRRL(BLRTSTDA,"INSID",INSCNT)=$TRANSLATE($PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI",INSCNT),2)),U,19),"~")
+27 ;insurance company name
SET BLRRL(BLRTSTDA,"INSCNME",INSCNT)=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI",INSCNT),0)),U)
+28 SET BLRRL(BLRTSTDA,"INSADD",INSCNT)=$$INSADD(BLRRL(BLRTSTDA,"INSI",INSCNT))
+29 SET BLRRL(BLRTSTDA,"INSADDE",INSCNT)=$TRANSLATE($PIECE(BLRRL(BLRTSTDA,"INSADD",INSCNT),U),U," ")_"~"_$TRANSLATE($PIECE(BLRRL(BLRTSTDA,"INSADD",INSCNT),U,3,99),U," ")
+30 SET BLRRL(BLRTSTDA,"INSPHO",INSCNT)=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),0)),U,6)
+31 SET BLRRL(BLRTSTDA,"INSTYP",INSCNT)=$PIECE($GET(^AUTNINS(BLRRL(BLRTSTDA,"INSI"),2)),U)
End DoDot:1
+32 SET BLRRL(BLRTSTDA,"INSEMP",INSCNT)=$$GET1^DIQ(2,PAT,.3111)
+33 SET BLRRL(BLRTSTDA,"INSNOI",INSCNT)=$$HLNAME^XLFNAME($PIECE(^DPT(PAT,0),U))
+34 SET BLRRL(BLRTSTDA,"INSNOIE",INSCNT)=$PIECE(^DPT(PAT,0),U)
+35 SET INSCNT=INSCNT+1
+36 ;end of hl7 lines
+37 QUIT
