- 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
