ABMDEVAR ; IHS/SD/SDR - SET UP CLAIM VARIABLES ;
;;2.6;IHS Third Party Billing;**1,4,6,7,10,11,13,14,18,21,27**;NOV 12, 2009;Build 486
;
;IHS/ASDS/DMJ - v2.4 p7 - 9/7/01 NOIS HQW-0701-100066
; Modifications done related to Medicare Part B.
;
;IHS/SD/SDR - v2.5 p8 - task 6
; Added code for new pages 3A and 8K
;IHS/SD/SDR - v2.5 p10 - IM20337
; Add page 9F to selection
;IHS/SD/SDR - v2.5 p11 - NPI
;
;IHS/SD/SDR 2.6*1 - HEAT6439 - Allow page9 for any 837 (not just 837P)
;IHS/SD/SDR 2.6*1 - HEAT7884 - display page7 if visit type 731
;IHS/SD/SDR 2.6*4 - HEAT15368 - <SUBSCR>PAGE+11^ABMDEVAR
;IHS/SD/SDR 2.6*6 - 5010 - added page 3B
;IHS/SD/SDR 2.6*13 - exp mode 35 - make page 9A show up
;IHS/SD/SDR 2.6*14 - ICD10 Updated go-live date to 10/1/2015; also added code to check ICD Indicator that acts as override for go-live date
;IHS/SD/SDR 2.6*14 - HEAT165301 - took out page 9A
;IHS/SD/SDR 2.6*18 - HEAT244054 - DOS same as ICD10 Effective Date was causing errors, page 5A to not work correctly.
;IHS/SD/SDR 2.6*21 - HEAT139641 - Changed 3P Insurer references from DUZ(2) to ABMP("LDFN")
;IHS/SD/AML 2.6*27 CR8897 Made page 7 display for Medi-cal bill type 731
;
S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
S ABMP("PDFN")=$P(ABMP("C0"),U)
S ABMP("VDT")=$P(ABMP("C0"),U,2)
S ABMP("VISTDT")=$$SDT^ABMDUTL(ABMP("VDT"))
S ABMP("DDT")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),U,3)]"":$P(^(6),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2))
S ABMP("LDFN")=$P(ABMP("C0"),U,3)
S ABMP("INS")=$P(ABMP("C0"),U,8)
;S ABMP("ICD10")=$S((ABMP("INS")'=""&$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12)'=""):$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12),1:3131001) ;abm*2.6*10 ICD10 023 ;abm*2.6*11 HEAT96776
;I +$G(ABMP("INS"))'=0 S ABMP("ICD10")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12) ;abm*2.6*11 HEAT96776 ;abm*2.6*14 ICD10 ICD Indicator
;start new code abm*2.6*14 ICD10 ICD Indicator
I +$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,21)=9 S ABMP("ICD10")=(ABMP("VDT")+1)
I +$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,21)=10 S ABMP("ICD10")=(ABMP("VDT")-1)
;S:(+$G(ABMP("ICD10"))=0&(+$G(ABMP("INS"))'=0)) ABMP("ICD10")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12) ;abm*2.6*18 IHS/SD/SDR HEAT244054
S:(+$G(ABMP("ICD10"))=0&(+$G(ABMP("INS"))'=0)) ABMP("ICD10")=($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12)-.00001) ;abm*2.6*18 IHS/SD/SDR HEAT244054
;end new code ICD10 ICD Indicator
;S:+$G(ABMP("ICD10"))=0 ABMP("ICD10")=3131001 ;abm*2.6*11 HEAT96776 ;abm*2.6*14 ICD10
;S:+$G(ABMP("ICD10"))=0 ABMP("ICD10")=3151001 ;abm*2.6*14 ICD10 ;abm*2.6*18 IHS/SD/SDR HEAT244054
S:+$G(ABMP("ICD10"))=0 ABMP("ICD10")=3150930.99999 ;abm*2.6*14 ICD10 ;abm*2.6*18 IHS/SD/SDR HEAT244054
I ABMP("INS")]"",'$D(^AUTNINS(ABMP("INS"),0)),'$G(ABMP("DERP OPT")) D
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.S DR=".08///@"
.D ^DIE
.S ABMP("INS")=""
S ABMP("DOB")=$P(^DPT(ABMP("PDFN"),0),U,3) I $G(^(.35)) S ABMP("DOD")=$P(^(.35),U)
;
S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
D BTYP
D ^ABMDE2X1
S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
S ABMP("CLN")=$S($P(ABMP("C0"),U,6):$P(ABMP("C0"),U,6),1:1)
I $G(ABMP("PX"))="" S ABMP("PX")="C"
D PAGE
D AFFL
D EXP
;
XIT K ABMX,ABMV
Q
;
BTYP ;EP - SET BILL TYPE
I '$G(^ABMDCLM(DUZ(2),+$G(ABMP("CDFN")),0)) D Q
.S:$D(ABMP("B0")) ABMP("BTYP")=$P(ABMP("B0"),U,2) Q
.S:$D(ABMP("C0")) ABMP("BTYP")=$P(ABMP("C0"),U,2) Q
.S ABMP("BTYP")=ABMP("VTYP")
S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
S ABMP("BTYP")=$P(ABMP("C0"),U,12)
S:'$G(ABMP("INS")) ABMP("INS")=$P(ABMP("C0"),U,8)
Q:ABMP("INS")=""
S:$P(ABMP("C0"),U,7)'="" ABMP("VTYP")=$P(ABMP("C0"),U,7)
I ABMP("VTYP")=121,ABMP("BTYP")'=121 S ABMP("BTYP")=""
;I ABMP("BTYP")=121,$P($G(^AUTNINS(ABMP("INS"),2)),U)'="R" S ABMP("BTYP")="" ;abm*2.6*10 HEAT73780
I ABMP("BTYP")=121,$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")'="R" S ABMP("BTYP")="" ;abm*2.6*10 HEAT73780
I ABMP("BTYP")="" D
.;I $P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0)),U,11) D ;abm*2.6*21 IHS/SD/AML HEAT139641
.I $P($G(^ABMNINS(ABMP("LDFN"),+ABMP("INS"),1,ABMP("VTYP"),0)),U,11) D ;abm*2.6*21 IHS/SD/AML HEAT139641
..;S ABMP("BTYP")=$P(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0),U,11) ;abm*2.6*21 IHS/SD/AML HEAT139641
..S ABMP("BTYP")=$P(^ABMNINS(ABMP("LDFN"),+ABMP("INS"),1,ABMP("VTYP"),0),U,11) ;abm*2.6*21 IHS/SD/AML HEAT139641
..S ABMP("BTYP")=$P($G(^ABMDCODE(ABMP("BTYP"),0)),U)
.S:ABMP("BTYP")<110!(ABMP("BTYP")>999) ABMP("BTYP")=""
.S:ABMP("BTYP")="" ABMP("BTYP")=$S(ABMP("VTYP")=111:111,ABMP("VTYP")=121:121,ABMP("VTYP")=831:831,1:131)
.;I ABMP("VTYP")=111,$P($G(^AUTNINS(ABMP("INS"),2)),U)="R" S ABMP("BTYP")=121 D ;abm*2.6*10 HEAT73780
.I ABMP("VTYP")=111,$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R" S ABMP("BTYP")=121 D ;abm*2.6*10 HEAT73780
..N I
..S I=0
..F S I=$O(^AUPNMCR(ABMP("PDFN"),11,I)) Q:'I D
...Q:$P(^AUPNMCR(ABMP("PDFN"),11,I,0),U)>ABMP("VDT")
...I $P(^AUPNMCR(ABMP("PDFN"),11,I,0),U,2)<ABMP("VDT"),$P(^(0),U,2)'="" Q
...Q:$P(^AUPNMCR(ABMP("PDFN"),11,I,0),U,3)'="A"
...S ABMP("BTYP")=111
..I ABMP("BTYP")=121 D
...N I
...S I=0
...F S I=$O(^AUPNRRE(ABMP("PDFN"),11,I)) Q:'I D
....Q:$P(^AUPNRRE(ABMP("PDFN"),11,I,0),U)>ABMP("VDT")
....I $P(^AUPNRRE(ABMP("PDFN"),11,I,0),U,2)<ABMP("VDT"),$P(^(0),U,2)'="" Q
....Q:$P(^AUPNRRE(ABMP("PDFN"),11,I,0),U,3)'="A"
....S ABMP("BTYP")=111
I ABMP("BTYP")'=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,12) D
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.S DR=".12///"_ABMP("BTYP")
.D ^DIE
Q
;
PAGE ;EP - SET SELECTABLE PAGES
S ABMP("PAGE")="0,1,2,3"
I $G(ABMP("CCLN"))="" D
.I $G(ABMP("CDFN"))'="" S ABMP("CLN")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,6)
.E S ABMP("CLN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10)
;I $P($G(^DIC(40.7,ABMP("CLN"),0)),U)="AMBULANCE" S ABMP("PAGE")=ABMP("PAGE")_",31" ;abm*2.6*7
I +$G(ABMP("CLN"))'=0,$P($G(^DIC(40.7,ABMP("CLN"),0)),U)="AMBULANCE" S ABMP("PAGE")=ABMP("PAGE")_",31" ;abm*2.6*7
;start new code abm*2.6*6 5010
I $G(ABMP("CDFN"))'="" D
.S ABMI=0
.F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI)) Q:'ABMI D
..Q:(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U)=0) ;abm*2.6*7 HEAT40762
..;I "^T^W^"[("^"_$P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U),2)),U)_"^")&(ABMP("PAGE")'["32") S ABMP("PAGE")=ABMP("PAGE")_",32" ;abm*2.6*10 HEAT73780
..S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
..I "^T^W^"[("^"_ABMITYP_"^")&(ABMP("PAGE")'["32") S ABMP("PAGE")=ABMP("PAGE")_",32" ;abm*2.6*10 HEAT73780
;end new code 5010
S ABMP("PAGE")=ABMP("PAGE")_",4,5"
S:ABMP("PX")="A" ABMP("PAGE")=ABMP("PAGE")_",6"
;I ABMP("VTYP")=111!($G(ABMP("BTYP"))=111)!($G(ABMP("BTYP"))=121)!(ABMP("VTYP")=831)!($G(ABMP("BTYP"))=181) S ABMP("PAGE")=ABMP("PAGE")_",7" ;IHS/SD/SDR 7/24/08
;I ABMP("VTYP")=111!($G(ABMP("BTYP"))=111)!($G(ABMP("BTYP"))=121)!(ABMP("VTYP")=831)!($G(ABMP("BTYP"))=181)!($G(ABMP("BTYP"))=731) S ABMP("PAGE")=ABMP("PAGE")_",7" ;IHS/SD/SDR 7/24/08
;start new code abm*2.6*1 HEAT7884
;I (ABMP("VTYP")=111!($G(ABMP("BTYP"))=111)!($G(ABMP("BTYP"))=121)!(ABMP("VTYP")=831)!($G(ABMP("BTYP"))=181)!(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))) S ABMP("PAGE")=ABMP("PAGE")_",7"
;abm*2.6*4 HEAT15368 - added + to ABMP("INS") to stop <SUBSCR>PAGE+11^ABMDEVAR
I (ABMP("VTYP")=111!($G(ABMP("BTYP"))=111)!($G(ABMP("BTYP"))=121)!(ABMP("VTYP")=831)!($G(ABMP("BTYP"))=181)!(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(+ABMP("INS"),0)),U)["MONTANA MEDICAID"))) S ABMP("PAGE")=ABMP("PAGE")_",7"
;end new code HEAT7884
;start new abm*2.6*27 IHS/SD/SDR CR8897
S ABMPOS=0 ;abm*2.6*27 IHS/SD/SDR CR8897
I "^51^52^53^54^55^"[("^"_$$GET1^DIQ(9002274.03,$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,6),".01","E")_"^") S ABMPOS=1 ;Place of Service setup for facility ;abm*2.6*27 IHS/SD/SDR CR8897
I (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(ABMP("BTYP")=731)&(ABMPOS=1) S ABMP("PAGE")=ABMP("PAGE")_",7"
;end new abm*2.6*27 IHS/SD/SDR CR8897
S:$G(ABMP("PX"))'="I"!(ABMP("VTYP")=831) ABMP("PAGE")=ABMP("PAGE")_",8"
;I $P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["UB"!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["ADA")!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["837 P") S ABMP("PAGE")=ABMP("PAGE")_",9" ;abm*2.6*1 HEAT6439
;abm*2.6*14 IHS/SD/SDR HEAT165301 put below line back in
;I $P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["UB"!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["ADA")!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["837") S ABMP("PAGE")=ABMP("PAGE")_",9" ;abm*2.6*1 HEAT6439 ;abm*2.6*13 exp mode 35
;abm*2.6*14 IHS/SD/SDR HEAT165301 put back in
I $P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["UB"!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["ADA")!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["837")!(+$G(ABMP("EXP"))=35) S ABMP("PAGE")=ABMP("PAGE")_",9" ;abm*2.6*13 exp mode 35
Q
;
AFFL ;EP - for determining Affiliation
S ABMX("AFFL")=""
S ABMX("I")=0
F S ABMX("I")=$O(^AUTTLOC(ABMP("LDFN"),11,ABMX("I"))) Q:'ABMX("I") S ABMX("IDT")=$S($P(^(ABMX("I"),0),U,2)]"":$P(^(0),U,2),1:9999999) I ABMP("VDT")>$P(^(0),U)&(ABMP("VDT")<ABMX("IDT")) S ABMX("AFFL")=$P(^(0),U,3)
I ABMX("AFFL")'=1 S ABMP(638)=""
K ABMX("AFFL"),ABMX("I")
Q
;
EXP ;EP for setting up Export Array
Q:'$G(ABMP("VTYP"))
F ABM=0:0 S ABM=$O(ABMP("VTYP",ABM)) Q:'ABM K ABMP("VTYP",ABM)
I '$G(ABMP("EXP")) D SET
I (^ABMDEXP(ABMP("EXP"),0)["HCFA")!(^ABMDEXP(ABMP("EXP"),0)["CMS") S ABMP("HCFA")=1
I ^ABMDEXP(ABMP("EXP"),0)["UB-92" S ABMP("UB92")=1
S ABMP("EXP",ABMP("EXP"))=""
S ABMP("VTYP",ABMP("VTYP"))=ABMP("EXP")
Q:'$G(ABMP("CDFN"))
;start old abm*2.6*21 IHS/SD/AML HEAT139641
;I $P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0)),U,6)="Y" D
;.Q:$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,999,0)),"^",7)="N"
;.S ABMP("VTYP",999)=$S($P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,999,0)),"^",4):$P(^(0),U,4),1:14)
;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
I $P($G(^ABMNINS(ABMP("LDFN"),+ABMP("INS"),1,ABMP("VTYP"),0)),U,6)="Y" D
.Q:$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,999,0)),"^",7)="N"
.S ABMP("VTYP",999)=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,999,0)),"^",4):$P(^(0),U,4),1:14)
.;end new abm*2.6*21 IHS/SD/AML HEAT139641
.F ABMPC=1,2 D
..Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),U,ABMPC)
..S $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),70),U,ABMPC)=ABMP("VTYP",999)
.K ABMPC
N I F I=1:1:11 D
.N J S J="8"_$C(64+I)
.S ABMP(J)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),U,I)
.S:ABMP(J)="" ABMP(J)=ABMP("EXP")
.S ABMP("EXP",ABMP(J))=""
Q
SET ;SET ABMP("EXP")
I $G(ABMP("CDFN")),$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,14) S ABMP("EXP")=$P(^(0),U,14) Q
I $P($G(^ABMNINS(DUZ(2),+$G(ABMP("INS")),1,ABMP("VTYP"),0)),U,4) S ABMP("EXP")=$P(^(0),U,4)
E S ABMP("EXP")=$S(ABMP("BTYP")=111:11,ABMP("BTYP")=831:11,ABMP("VTYP")=998&$P($G(^ABMDPARM(DUZ(2),1,3)),U,2):$P(^(3),U,2),1:3)
Q
ABMDEVAR ; IHS/SD/SDR - SET UP CLAIM VARIABLES ;
+1 ;;2.6;IHS Third Party Billing;**1,4,6,7,10,11,13,14,18,21,27**;NOV 12, 2009;Build 486
+2 ;
+3 ;IHS/ASDS/DMJ - v2.4 p7 - 9/7/01 NOIS HQW-0701-100066
+4 ; Modifications done related to Medicare Part B.
+5 ;
+6 ;IHS/SD/SDR - v2.5 p8 - task 6
+7 ; Added code for new pages 3A and 8K
+8 ;IHS/SD/SDR - v2.5 p10 - IM20337
+9 ; Add page 9F to selection
+10 ;IHS/SD/SDR - v2.5 p11 - NPI
+11 ;
+12 ;IHS/SD/SDR 2.6*1 - HEAT6439 - Allow page9 for any 837 (not just 837P)
+13 ;IHS/SD/SDR 2.6*1 - HEAT7884 - display page7 if visit type 731
+14 ;IHS/SD/SDR 2.6*4 - HEAT15368 - <SUBSCR>PAGE+11^ABMDEVAR
+15 ;IHS/SD/SDR 2.6*6 - 5010 - added page 3B
+16 ;IHS/SD/SDR 2.6*13 - exp mode 35 - make page 9A show up
+17 ;IHS/SD/SDR 2.6*14 - ICD10 Updated go-live date to 10/1/2015; also added code to check ICD Indicator that acts as override for go-live date
+18 ;IHS/SD/SDR 2.6*14 - HEAT165301 - took out page 9A
+19 ;IHS/SD/SDR 2.6*18 - HEAT244054 - DOS same as ICD10 Effective Date was causing errors, page 5A to not work correctly.
+20 ;IHS/SD/SDR 2.6*21 - HEAT139641 - Changed 3P Insurer references from DUZ(2) to ABMP("LDFN")
+21 ;IHS/SD/AML 2.6*27 CR8897 Made page 7 display for Medi-cal bill type 731
+22 ;
+23 SET ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+24 SET ABMP("PDFN")=$PIECE(ABMP("C0"),U)
+25 SET ABMP("VDT")=$PIECE(ABMP("C0"),U,2)
+26 SET ABMP("VISTDT")=$$SDT^ABMDUTL(ABMP("VDT"))
+27 SET ABMP("DDT")=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),6)),U,3)]"":$PIECE(^(6),U,3),1:$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2))
+28 SET ABMP("LDFN")=$PIECE(ABMP("C0"),U,3)
+29 SET ABMP("INS")=$PIECE(ABMP("C0"),U,8)
+30 ;S ABMP("ICD10")=$S((ABMP("INS")'=""&$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12)'=""):$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12),1:3131001) ;abm*2.6*10 ICD10 023 ;abm*2.6*11 HEAT96776
+31 ;I +$G(ABMP("INS"))'=0 S ABMP("ICD10")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12) ;abm*2.6*11 HEAT96776 ;abm*2.6*14 ICD10 ICD Indicator
+32 ;start new code abm*2.6*14 ICD10 ICD Indicator
+33 IF +$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,21)=9
SET ABMP("ICD10")=(ABMP("VDT")+1)
+34 IF +$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,21)=10
SET ABMP("ICD10")=(ABMP("VDT")-1)
+35 ;S:(+$G(ABMP("ICD10"))=0&(+$G(ABMP("INS"))'=0)) ABMP("ICD10")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12) ;abm*2.6*18 IHS/SD/SDR HEAT244054
+36 ;abm*2.6*18 IHS/SD/SDR HEAT244054
IF (+$GET(ABMP("ICD10"))=0&(+$GET(ABMP("INS"))'=0))
SET ABMP("ICD10")=($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,12)-.00001)
+37 ;end new code ICD10 ICD Indicator
+38 ;S:+$G(ABMP("ICD10"))=0 ABMP("ICD10")=3131001 ;abm*2.6*11 HEAT96776 ;abm*2.6*14 ICD10
+39 ;S:+$G(ABMP("ICD10"))=0 ABMP("ICD10")=3151001 ;abm*2.6*14 ICD10 ;abm*2.6*18 IHS/SD/SDR HEAT244054
+40 ;abm*2.6*14 ICD10 ;abm*2.6*18 IHS/SD/SDR HEAT244054
IF +$GET(ABMP("ICD10"))=0
SET ABMP("ICD10")=3150930.99999
+41 IF ABMP("INS")]""
IF '$DATA(^AUTNINS(ABMP("INS"),0))
IF '$GET(ABMP("DERP OPT"))
Begin DoDot:1
+42 SET DIE="^ABMDCLM(DUZ(2),"
+43 SET DA=ABMP("CDFN")
+44 SET DR=".08///@"
+45 DO ^DIE
+46 SET ABMP("INS")=""
End DoDot:1
+47 SET ABMP("DOB")=$PIECE(^DPT(ABMP("PDFN"),0),U,3)
IF $GET(^(.35))
SET ABMP("DOD")=$PIECE(^(.35),U)
+48 ;
+49 SET ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
+50 DO BTYP
+51 DO ^ABMDE2X1
+52 SET ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+53 SET ABMP("CLN")=$SELECT($PIECE(ABMP("C0"),U,6):$PIECE(ABMP("C0"),U,6),1:1)
+54 IF $GET(ABMP("PX"))=""
SET ABMP("PX")="C"
+55 DO PAGE
+56 DO AFFL
+57 DO EXP
+58 ;
XIT KILL ABMX,ABMV
+1 QUIT
+2 ;
BTYP ;EP - SET BILL TYPE
+1 IF '$GET(^ABMDCLM(DUZ(2),+$GET(ABMP("CDFN")),0))
Begin DoDot:1
+2 IF $DATA(ABMP("B0"))
SET ABMP("BTYP")=$PIECE(ABMP("B0"),U,2)
QUIT
+3 IF $DATA(ABMP("C0"))
SET ABMP("BTYP")=$PIECE(ABMP("C0"),U,2)
QUIT
+4 SET ABMP("BTYP")=ABMP("VTYP")
End DoDot:1
QUIT
+5 SET ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+6 SET ABMP("BTYP")=$PIECE(ABMP("C0"),U,12)
+7 IF '$GET(ABMP("INS"))
SET ABMP("INS")=$PIECE(ABMP("C0"),U,8)
+8 IF ABMP("INS")=""
QUIT
+9 IF $PIECE(ABMP("C0"),U,7)'=""
SET ABMP("VTYP")=$PIECE(ABMP("C0"),U,7)
+10 IF ABMP("VTYP")=121
IF ABMP("BTYP")'=121
SET ABMP("BTYP")=""
+11 ;I ABMP("BTYP")=121,$P($G(^AUTNINS(ABMP("INS"),2)),U)'="R" S ABMP("BTYP")="" ;abm*2.6*10 HEAT73780
+12 ;abm*2.6*10 HEAT73780
IF ABMP("BTYP")=121
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")'="R"
SET ABMP("BTYP")=""
+13 IF ABMP("BTYP")=""
Begin DoDot:1
+14 ;I $P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0)),U,11) D ;abm*2.6*21 IHS/SD/AML HEAT139641
+15 ;abm*2.6*21 IHS/SD/AML HEAT139641
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),+ABMP("INS"),1,ABMP("VTYP"),0)),U,11)
Begin DoDot:2
+16 ;S ABMP("BTYP")=$P(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0),U,11) ;abm*2.6*21 IHS/SD/AML HEAT139641
+17 ;abm*2.6*21 IHS/SD/AML HEAT139641
SET ABMP("BTYP")=$PIECE(^ABMNINS(ABMP("LDFN"),+ABMP("INS"),1,ABMP("VTYP"),0),U,11)
+18 SET ABMP("BTYP")=$PIECE($GET(^ABMDCODE(ABMP("BTYP"),0)),U)
End DoDot:2
+19 IF ABMP("BTYP")<110!(ABMP("BTYP")>999)
SET ABMP("BTYP")=""
+20 IF ABMP("BTYP")=""
SET ABMP("BTYP")=$SELECT(ABMP("VTYP")=111:111,ABMP("VTYP")=121:121,ABMP("VTYP")=831:831,1:131)
+21 ;I ABMP("VTYP")=111,$P($G(^AUTNINS(ABMP("INS"),2)),U)="R" S ABMP("BTYP")=121 D ;abm*2.6*10 HEAT73780
+22 ;abm*2.6*10 HEAT73780
IF ABMP("VTYP")=111
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R"
SET ABMP("BTYP")=121
Begin DoDot:2
+23 NEW I
+24 SET I=0
+25 FOR
SET I=$ORDER(^AUPNMCR(ABMP("PDFN"),11,I))
IF 'I
QUIT
Begin DoDot:3
+26 IF $PIECE(^AUPNMCR(ABMP("PDFN"),11,I,0),U)>ABMP("VDT")
QUIT
+27 IF $PIECE(^AUPNMCR(ABMP("PDFN"),11,I,0),U,2)<ABMP("VDT")
IF $PIECE(^(0),U,2)'=""
QUIT
+28 IF $PIECE(^AUPNMCR(ABMP("PDFN"),11,I,0),U,3)'="A"
QUIT
+29 SET ABMP("BTYP")=111
End DoDot:3
+30 IF ABMP("BTYP")=121
Begin DoDot:3
+31 NEW I
+32 SET I=0
+33 FOR
SET I=$ORDER(^AUPNRRE(ABMP("PDFN"),11,I))
IF 'I
QUIT
Begin DoDot:4
+34 IF $PIECE(^AUPNRRE(ABMP("PDFN"),11,I,0),U)>ABMP("VDT")
QUIT
+35 IF $PIECE(^AUPNRRE(ABMP("PDFN"),11,I,0),U,2)<ABMP("VDT")
IF $PIECE(^(0),U,2)'=""
QUIT
+36 IF $PIECE(^AUPNRRE(ABMP("PDFN"),11,I,0),U,3)'="A"
QUIT
+37 SET ABMP("BTYP")=111
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+38 IF ABMP("BTYP")'=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,12)
Begin DoDot:1
+39 SET DIE="^ABMDCLM(DUZ(2),"
+40 SET DA=ABMP("CDFN")
+41 SET DR=".12///"_ABMP("BTYP")
+42 DO ^DIE
End DoDot:1
+43 QUIT
+44 ;
PAGE ;EP - SET SELECTABLE PAGES
+1 SET ABMP("PAGE")="0,1,2,3"
+2 IF $GET(ABMP("CCLN"))=""
Begin DoDot:1
+3 IF $GET(ABMP("CDFN"))'=""
SET ABMP("CLN")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,6)
+4 IF '$TEST
SET ABMP("CLN")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10)
End DoDot:1
+5 ;I $P($G(^DIC(40.7,ABMP("CLN"),0)),U)="AMBULANCE" S ABMP("PAGE")=ABMP("PAGE")_",31" ;abm*2.6*7
+6 ;abm*2.6*7
IF +$GET(ABMP("CLN"))'=0
IF $PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U)="AMBULANCE"
SET ABMP("PAGE")=ABMP("PAGE")_",31"
+7 ;start new code abm*2.6*6 5010
+8 IF $GET(ABMP("CDFN"))'=""
Begin DoDot:1
+9 SET ABMI=0
+10 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI))
IF 'ABMI
QUIT
Begin DoDot:2
+11 ;abm*2.6*7 HEAT40762
IF (+$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U)=0)
QUIT
+12 ;I "^T^W^"[("^"_$P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U),2)),U)_"^")&(ABMP("PAGE")'["32") S ABMP("PAGE")=ABMP("PAGE")_",32" ;abm*2.6*10 HEAT73780
+13 ;abm*2.6*10 HEAT73780
SET ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMI,0)),U),".211","I"),1,"I")
+14 ;abm*2.6*10 HEAT73780
IF "^T^W^"[("^"_ABMITYP_"^")&(ABMP("PAGE")'["32")
SET ABMP("PAGE")=ABMP("PAGE")_",32"
End DoDot:2
End DoDot:1
+15 ;end new code 5010
+16 SET ABMP("PAGE")=ABMP("PAGE")_",4,5"
+17 IF ABMP("PX")="A"
SET ABMP("PAGE")=ABMP("PAGE")_",6"
+18 ;I ABMP("VTYP")=111!($G(ABMP("BTYP"))=111)!($G(ABMP("BTYP"))=121)!(ABMP("VTYP")=831)!($G(ABMP("BTYP"))=181) S ABMP("PAGE")=ABMP("PAGE")_",7" ;IHS/SD/SDR 7/24/08
+19 ;I ABMP("VTYP")=111!($G(ABMP("BTYP"))=111)!($G(ABMP("BTYP"))=121)!(ABMP("VTYP")=831)!($G(ABMP("BTYP"))=181)!($G(ABMP("BTYP"))=731) S ABMP("PAGE")=ABMP("PAGE")_",7" ;IHS/SD/SDR 7/24/08
+20 ;start new code abm*2.6*1 HEAT7884
+21 ;I (ABMP("VTYP")=111!($G(ABMP("BTYP"))=111)!($G(ABMP("BTYP"))=121)!(ABMP("VTYP")=831)!($G(ABMP("BTYP"))=181)!(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))) S ABMP("PAGE")=ABMP("PAGE")_",7"
+22 ;abm*2.6*4 HEAT15368 - added + to ABMP("INS") to stop <SUBSCR>PAGE+11^ABMDEVAR
+23 IF (ABMP("VTYP")=111!($GET(ABMP("BTYP"))=111)!($GET(ABMP("BTYP"))=121)!(ABMP("VTYP")=831)!($GET(ABMP("BTYP"))=181)!(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($PIECE($GET(^AUTNINS(+ABMP("INS"),0)),U)["MONTANA MEDICAID")))
SET ABMP("PAGE")=ABMP("PAGE")_",7"
+24 ;end new code HEAT7884
+25 ;start new abm*2.6*27 IHS/SD/SDR CR8897
+26 ;abm*2.6*27 IHS/SD/SDR CR8897
SET ABMPOS=0
+27 ;Place of Service setup for facility ;abm*2.6*27 IHS/SD/SDR CR8897
IF "^51^52^53^54^55^"[("^"_$$GET1^DIQ(9002274.03,$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,6),".01","E")_"^")
SET ABMPOS=1
+28 IF (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(ABMP("BTYP")=731)&(ABMPOS=1)
SET ABMP("PAGE")=ABMP("PAGE")_",7"
+29 ;end new abm*2.6*27 IHS/SD/SDR CR8897
+30 IF $GET(ABMP("PX"))'="I"!(ABMP("VTYP")=831)
SET ABMP("PAGE")=ABMP("PAGE")_",8"
+31 ;I $P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["UB"!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["ADA")!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["837 P") S ABMP("PAGE")=ABMP("PAGE")_",9" ;abm*2.6*1 HEAT6439
+32 ;abm*2.6*14 IHS/SD/SDR HEAT165301 put below line back in
+33 ;I $P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["UB"!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["ADA")!($P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)["837") S ABMP("PAGE")=ABMP("PAGE")_",9" ;abm*2.6*1 HEAT6439 ;abm*2.6*13 exp mode 35
+34 ;abm*2.6*14 IHS/SD/SDR HEAT165301 put back in
+35 ;abm*2.6*13 exp mode 35
IF $PIECE($GET(^ABMDEXP(+$GET(ABMP("EXP")),0)),U)["UB"!($PIECE($GET(^ABMDEXP(+$GET(ABMP("EXP")),0)),U)["ADA")!($PIECE($GET(^ABMDEXP(+$GET(ABMP("EXP")),0)),U)["837")!(+$GET(ABMP("EXP"))=35)
SET ABMP("PAGE")=ABMP("PAGE")_",9"
+36 QUIT
+37 ;
AFFL ;EP - for determining Affiliation
+1 SET ABMX("AFFL")=""
+2 SET ABMX("I")=0
+3 FOR
SET ABMX("I")=$ORDER(^AUTTLOC(ABMP("LDFN"),11,ABMX("I")))
IF 'ABMX("I")
QUIT
SET ABMX("IDT")=$SELECT($PIECE(^(ABMX("I"),0),U,2)]"":$PIECE(^(0),U,2),1:9999999)
IF ABMP("VDT")>$PIECE(^(0),U)&(ABMP("VDT")<ABMX("IDT"))
SET ABMX("AFFL")=$PIECE(^(0),U,3)
+4 IF ABMX("AFFL")'=1
SET ABMP(638)=""
+5 KILL ABMX("AFFL"),ABMX("I")
+6 QUIT
+7 ;
EXP ;EP for setting up Export Array
+1 IF '$GET(ABMP("VTYP"))
QUIT
+2 FOR ABM=0:0
SET ABM=$ORDER(ABMP("VTYP",ABM))
IF 'ABM
QUIT
KILL ABMP("VTYP",ABM)
+3 IF '$GET(ABMP("EXP"))
DO SET
+4 IF (^ABMDEXP(ABMP("EXP"),0)["HCFA")!(^ABMDEXP(ABMP("EXP"),0)["CMS")
SET ABMP("HCFA")=1
+5 IF ^ABMDEXP(ABMP("EXP"),0)["UB-92"
SET ABMP("UB92")=1
+6 SET ABMP("EXP",ABMP("EXP"))=""
+7 SET ABMP("VTYP",ABMP("VTYP"))=ABMP("EXP")
+8 IF '$GET(ABMP("CDFN"))
QUIT
+9 ;start old abm*2.6*21 IHS/SD/AML HEAT139641
+10 ;I $P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0)),U,6)="Y" D
+11 ;.Q:$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,999,0)),"^",7)="N"
+12 ;.S ABMP("VTYP",999)=$S($P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,999,0)),"^",4):$P(^(0),U,4),1:14)
+13 ;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
+14 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),+ABMP("INS"),1,ABMP("VTYP"),0)),U,6)="Y"
Begin DoDot:1
+15 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,999,0)),"^",7)="N"
QUIT
+16 SET ABMP("VTYP",999)=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,999,0)),"^",4):$PIECE(^(0),U,4),1:14)
+17 ;end new abm*2.6*21 IHS/SD/AML HEAT139641
+18 FOR ABMPC=1,2
Begin DoDot:2
+19 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),U,ABMPC)
QUIT
+20 SET $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),70),U,ABMPC)=ABMP("VTYP",999)
End DoDot:2
+21 KILL ABMPC
End DoDot:1
+22 NEW I
FOR I=1:1:11
Begin DoDot:1
+23 NEW J
SET J="8"_$CHAR(64+I)
+24 SET ABMP(J)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),U,I)
+25 IF ABMP(J)=""
SET ABMP(J)=ABMP("EXP")
+26 SET ABMP("EXP",ABMP(J))=""
End DoDot:1
+27 QUIT
SET ;SET ABMP("EXP")
+1 IF $GET(ABMP("CDFN"))
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,14)
SET ABMP("EXP")=$PIECE(^(0),U,14)
QUIT
+2 IF $PIECE($GET(^ABMNINS(DUZ(2),+$GET(ABMP("INS")),1,ABMP("VTYP"),0)),U,4)
SET ABMP("EXP")=$PIECE(^(0),U,4)
+3 IF '$TEST
SET ABMP("EXP")=$SELECT(ABMP("BTYP")=111:11,ABMP("BTYP")=831:11,ABMP("VTYP")=998&$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),U,2):$PIECE(^(3),U,2),1:3)
+4 QUIT
