ABMDF27D.m

ABMDF27D ; IHS/ASDST/DMJ - Set HCFA1500 (08/05) Print Array - Part 4 ;  

 ;;2.6;IHS Third Party Billing;**1,2,4,6,9,11,14**;NOV 12, 2009;Build 238

 ;

 ; IHS/SD/SDR - v2.5 p12 - IM25331

 ;   Put taxonomy code if NPI ONLY

 ; IHS/SD/SDR,AML - v2.5 p13 - NO IM

 ; IHS/SD/SDR - v2.5 p13 - IM26203

 ;

 ; IHS/SD/SDR - v2.6 CSV

 ; IHS/SD/SDR - abm*2.6*1 - HEAT5612 - modifier wasn't printing

 ; IHS/SD/SDR - abm*2.6*2 - FIXPMS10006 - check for print date (FL31)

 ; IHS/SD/SDR - abm*2.6*4 - HEAT12115 - made change to allow 8 DX codes to print

 ; IHS/SD/SDR - 2.6*9 - HEAT46087 - Changed so it will print 4 or 8 DXs based on parameter

 ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative

 ;IHS/SD/SDR - 2.6*14 - Updated calls to DX^ABMCVAPI to be numeric

 ; *********************************************************************

 ;

DX ; Diagnosis Info

 K ABMP("DX")

 ;S ABM="" F ABM("I")=31:1:34 S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM)) Q:'ABM  D  ;abm*2.6*4 HEAT12115

 ;S ABM="" F ABM("I")=31:1:38 S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM)) Q:'ABM  D  ;abm*2.6*4 HEAT12115  ;abm*2.6*9 HEAT46087

 S ABMEND=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,16)=8:38,1:34)  ;abm*2.6*9 HEAT46087

 S ABM="" F ABM("I")=31:1:ABMEND S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM)) Q:'ABM  D  ;abm*2.6*4 HEAT12115  ;abm*2.6*9 HEAT46087

 .S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM,""))

 .;S ABM(9)=$P(^AUTNPOV($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABM("X"),0),U,3),0),U)  ;abm*2.6*14 HEAT161263

 .S ABM(9)=$$GET1^DIQ(9999999.27,$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABM("X"),0),U,3),".01","E")  ;abm*2.6*14 HEAT161263

 .S ABM(9)=$S(ABM(9)["*ICD*":$P(ABM(9),"  "),1:ABM(9))

 .;S ABM("ID")=$S(ABM("I")=32:33,ABM("I")=34:33,1:31)  ;abm*2.6*4 HEAT12115

 .;S ABM("ID")=$S(ABM("I")=32:33,ABM("I")=34:33,ABM("I")=36:33,ABM("I")=38:33,1:31)  ;abm*2.6*4 HEAT12115  ;abm*2.6*9 HEAT46087

 .;S ABM("TB")=$S(ABM("I")<33:1,1:2)  ;abm*2.6*4 HEAT12115

 .;S ABM("TB")=$S(ABM("I")<33:1,ABM("I")<35:3,ABM("I")<37:2,1:4)  ;abm*2.6*4 HEAT12115  ;abm*2.6*9 HEAT46087

 .;start new code abm*2.6*9 HEAT46087

 .I ABMEND=38 D

 ..S ABM("ID")=$S(ABM("I")=32:33,ABM("I")=34:33,ABM("I")=36:33,ABM("I")=38:33,1:31)

 .I ABMEND=34 D

 ..S ABM("ID")=$S(ABM("I")=32:33,ABM("I")=34:33,1:31)

 .S ABM("TB")=$S(ABM("I")<33:1,ABM("I")<35:3,ABM("I")<37:2,1:4)

 .;end new code HEAT46087

 .S ABM(9)=""

 .;S ABM("DIAG")=$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,2)  ; CSV-c  ;abm*2.6*14 update API call

 .S ABM("DIAG")=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)  ; CSV-c  ;abm*2.6*14 update API call

 .;I $P($G(^AUTNINS(ABMP("INS"),0)),U)="PHC MEDICAID" S ABM("DIAG")=$TR($P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,2),".")  ;abm*2.6*11 IHS/SD/AML 3/31/2011 HEAT30524 - REMOVE DECIMAL FOR PARTNERSHIP  ;abm*2.6*14 update API call

 .I $P($G(^AUTNINS(ABMP("INS"),0)),U)="PHC MEDICAID" S ABM("DIAG")=$TR($P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2),".")  ;abm*2.6*11 IHS/SD/AML 3/31/2011 HEAT30524 - REMOVE DECIMAL FOR PARTNERSHIP  ;abm*2.6*14 update API call

 .;start old code abm*2.6*9 HEAT46087

 .;S ABM("DIAG")=$S(ABM("I")=35:"5. "_ABM("DIAG"),ABM("I")=36:"6. "_ABM("DIAG"),ABM("I")=37:"7. "_ABM("DIAG"),ABM("I")=38:"8. "_ABM("DIAG"),1:ABM("DIAG"))  ;abm*2.6*4 HEAT12115

 .;end old code start new code HEAT46087

 .I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,16)=8 D

 ..S ABM("DIAG")=$S(ABM("I")=35:"5. "_ABM("DIAG"),ABM("I")=36:"6. "_ABM("DIAG"),ABM("I")=37:"7. "_ABM("DIAG"),ABM("I")=38:"8. "_ABM("DIAG"),1:ABM("DIAG"))  ;abm*2.6*4 HEAT12115

 .;end new code HEAT46087

 .;I ABMP("ITYPE")'="R",(ABM("I")>34) Q  ;abm*2.6*6 HEAT12115  ;abm*2.6*9 HEAT46087

 .S $P(ABMF(ABM("ID")),U,ABM("TB"))=ABM("DIAG")_" "_ABM(9)

 .S ABMP("DX",ABM("DIAG"))=ABM("I")-30

 ;

ST S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","

 S ABMPRINT=1 D ^ABMDESM1

 I $P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3" D

 .S ABMI=0

 .F  S ABMI=$O(ABMS(ABMI)) Q:'ABMI  D

 ..I $P($P(ABMS(ABMI),U,4),"-",2)="QL" S ABMQLFLG=1

 ..S ABMODMOD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)

 .S ABMI=0

 .F  S ABMI=$O(ABMS(ABMI)) Q:'ABMI  D

 ..I $G(ABMQLFLG)=1,($P($P(ABMS(ABMI),U,4)," ",2)'="QL") S $P(ABMS(ABMI),U,4)=$P($P(ABMS(ABMI),U,4)," ")

 ..;I $G(ABMQLFLG)'=1 S $P(ABMS(ABMI),U,4)=$P($P(ABMS(ABMI),U,4)," ")_$P($P(ABMS(ABMI),U,4)," ",2)_"  "_ABMODMOD  ;abm*2.6*1 HEAT5612

 ..I $G(ABMQLFLG)'=1 S $P(ABMS(ABMI),U,4)=$P(ABMS(ABMI),U,4)_"  "_ABMODMOD  ;abm*2.6*1 HEAT5612

 K ABMQLFLG

HCFA ;

 I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U)=0 S ABMS("TOT")=0

 D EMG^ABMDF27E  ;set EMG flag

 S ABMS=0

 F  S ABMS=$O(ABMS(ABMS)) Q:+ABMS=0  D

 .S ABMLN=2

 .D PROC^ABMDF27E

 .S ABMLN=ABMLN+1

 S ABMLN=0,ABMPRT=0

 F ABMS("I")=37:2:47 D  Q:$G(ABM("QUIT"))

 .S ABMLN=$O(ABMR(ABMLN))

 .Q:+ABMLN=0

 .S ABMPRT=0

 .I (($O(ABMR(ABMLN,9),-1))+(ABMS("I")))>49 Q

 .F  S ABMPRT=$O(ABMR(ABMLN,ABMPRT)) Q:+ABMPRT=0  D

 ..M ABMF($S(ABMPRT=1:(ABMS("I")-1),1:ABMS("I")))=ABMR(ABMLN,ABMPRT)

 ..K ABMR(ABMLN,ABMPRT)

 ;

 D PREV^ABMDFUTL

 S ABM("RATIO")=+^ABMDBILL(DUZ(2),ABMP("BDFN"),2)/$S($P(^(2),U,3):$P(^(2),U,3),1:1)

 S:ABM("RATIO")>1 ABM("RATIO")=1

 S ABM("W")=+$FN(ABMP("WO")*ABM("RATIO"),"",2)

 I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,17)="DO" D

 .S $P(ABMF(49),U,8)=+$FN(ABMP("PD")*ABM("RATIO"),"",2)+ABM("W")

 S ABM("OB")=ABMS("TOT")-$P(ABMF(49),U,8)

 S:ABM("OB")<0 ABM("OB")=0

 S ABM("YTOT")=ABM("OB")

 D YTOT^ABMDFUTL

 S $P(ABMF(49),U,7)=ABMS("TOT")    ; Total Charges

 I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,17)="DO" D

 .S $P(ABMF(49),U,8)=+$FN(ABMP("PD"),"",2)

 ; Amount Due

 I $D(ABMP("BILL")) S $P(ABMF(49),U,9)=+$FN(ABMP("BILL"),"",2)

 E  S $P(ABMF(49),U,9)=+$FN(ABMS("TOT")-ABMP("PD"),"",2)-$G(ABMP("PENS"))-$G(ABMP("NONC"))

 K ABMS

 I $D(ABMR) D

 .S ABMR("TOT")=$P(ABMF(49),U,7,9)

 .S $P(ABMF(49),U,7)="",$P(ABMF(49),U,8)="",$P(ABMF(49),U,9)=""

 ;

PRV ; Provider Info

 I $P($G(^ABMDPARM(DUZ(2),1,0)),"^",17)=3 D  G PDT

 .S ABM("SIGN")=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",7)

 .I ABM("SIGN")="" D

 ..S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0)) D

 ...Q:'ABM("X")

 ...D SELBILL^ABMDE4X

 ...S ABM("SIGN")=$P(ABM("A"),U,2)

 .E  D

 ..S ABM("A")=$P($G(^VA(200,+ABM("SIGN"),20)),"^",2)_"^"_+ABM("SIGN")

 I $P($G(^ABMDPARM(DUZ(2),1,0)),U,17)=2 D  G PDT

 S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0)) D

 .Q:'ABM("X")

 .D SELBILL^ABMDE4X

 .S $P(ABMF(52),U)=$P($G(^VA(200,+$P(ABM("A"),"^",2),20)),"^",2)

 .S:$P(ABMF(52),U)="" $P(ABMF(52),U)=$P(ABM("A"),U)

PDT ;S $P(ABMF(54),U)=DT  ;abm*2.6*2 FIXPMS10006

 ;S $P(ABMF(54),U)=$S($G(ABMPDT)="O":$P($G(^ABMDTXST(DUZ(2),+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),1:DT)  ;abm*2.6*2 FIXPMS10006  ;abm*2.6*4 HEAT17615

 ;S $P(ABMF(54),U)=$S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),1:DT)  ;abm*2.6*2 FIXPMS10006  ;abm*2.6*4 HEAT17615  ;abm*2.6*11 HEAT81561

 S $P(ABMF(54),U)=$S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),$G(ABMP("PRINTDT"))="A":$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5),1:DT)  ;abm*2.6*11 HEAT81561

 I $D(ABM("A")) D

 .S ABM("PRO")=$P(ABM("A"),U,2)

 .S $P(ABMF(54),U,4)=$S($P($$NPI^XUSNPI("Individual_ID",ABM("PRO")),U)>0:$P($$NPI^XUSNPI("Individual_ID",ABM("PRO")),U),1:"")

 .S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))

 .S $P(ABMF(54),U,4)=$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)

 .S ABMPQ=$S(ABMP("ITYPE")="R":"1C",ABMP("ITYPE")="D":"1D",$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")

 .S:$G(ABMPQ)="" ABMPQ="G2"

 .S:($G(ABMP("NPIS"))'="")&($G(ABMP("NPIS"))'="N") $P(ABMF(54),U,5)=$G(ABMPQ)_$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)

 .I ($G(ABMP("NPIS"))'="")&($G(ABMP("NPIS"))'="N") S $P(ABMF(54),U,5)="ZZ"_$$PTAX^ABMEEPRV(ABM("PRO"))

 I $P($G(^AUTNINS(ABMP("INS"),0)),U)["ALASKA MEDICAID" D

 .Q:$P($G(ABMF(37)),U,3)'=22  ;only change for POS 22

 .S $P(ABMF(54),U,4)="982808978",$P(ABMF(54),U,5)="1DCL461"

 ;

XIT K ABM,ABMV,ABMX,ABMPRINT

 Q

ABMDF27D  ; IHS/ASDST/DMJ - Set HCFA1500 (08/05) Print Array - Part 4 ;  

 +1       ;;2.6;IHS Third Party Billing;**1,2,4,6,9,11,14**;NOV 12, 2009;Build 238

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p12 - IM25331

 +4       ;   Put taxonomy code if NPI ONLY

 +5       ; IHS/SD/SDR,AML - v2.5 p13 - NO IM

 +6       ; IHS/SD/SDR - v2.5 p13 - IM26203

 +7       ;

 +8       ; IHS/SD/SDR - v2.6 CSV

 +9       ; IHS/SD/SDR - abm*2.6*1 - HEAT5612 - modifier wasn't printing

 +10      ; IHS/SD/SDR - abm*2.6*2 - FIXPMS10006 - check for print date (FL31)

 +11      ; IHS/SD/SDR - abm*2.6*4 - HEAT12115 - made change to allow 8 DX codes to print

 +12      ; IHS/SD/SDR - 2.6*9 - HEAT46087 - Changed so it will print 4 or 8 DXs based on parameter

 +13      ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative

 +14      ;IHS/SD/SDR - 2.6*14 - Updated calls to DX^ABMCVAPI to be numeric

 +15      ; *********************************************************************

 +16      ;

DX        ; Diagnosis Info

 +1        KILL ABMP("DX")

 +2       ;S ABM="" F ABM("I")=31:1:34 S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM)) Q:'ABM  D  ;abm*2.6*4 HEAT12115

 +3       ;S ABM="" F ABM("I")=31:1:38 S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM)) Q:'ABM  D  ;abm*2.6*4 HEAT12115  ;abm*2.6*9 HEAT46087

 +4       ;abm*2.6*9 HEAT46087

           SET ABMEND=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,16)=8:38,1:34)

 +5       ;abm*2.6*4 HEAT12115  ;abm*2.6*9 HEAT46087

           SET ABM=""

           FOR ABM("I")=31:1:ABMEND

               SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +6                SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM,""))

 +7       ;S ABM(9)=$P(^AUTNPOV($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABM("X"),0),U,3),0),U)  ;abm*2.6*14 HEAT161263

 +8       ;abm*2.6*14 HEAT161263

                   SET ABM(9)=$$GET1^DIQ(9999999.27,$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABM("X"),0),U,3),".01","E")

 +9                SET ABM(9)=$SELECT(ABM(9)["*ICD*":$PIECE(ABM(9),"  "),1:ABM(9))

 +10      ;S ABM("ID")=$S(ABM("I")=32:33,ABM("I")=34:33,1:31)  ;abm*2.6*4 HEAT12115

 +11      ;S ABM("ID")=$S(ABM("I")=32:33,ABM("I")=34:33,ABM("I")=36:33,ABM("I")=38:33,1:31)  ;abm*2.6*4 HEAT12115  ;abm*2.6*9 HEAT46087

 +12      ;S ABM("TB")=$S(ABM("I")<33:1,1:2)  ;abm*2.6*4 HEAT12115

 +13      ;S ABM("TB")=$S(ABM("I")<33:1,ABM("I")<35:3,ABM("I")<37:2,1:4)  ;abm*2.6*4 HEAT12115  ;abm*2.6*9 HEAT46087

 +14      ;start new code abm*2.6*9 HEAT46087

 +15               IF ABMEND=38

                       Begin DoDot:2

 +16                       SET ABM("ID")=$SELECT(ABM("I")=32:33,ABM("I")=34:33,ABM("I")=36:33,ABM("I")=38:33,1:31)

                       End DoDot:2

 +17               IF ABMEND=34

                       Begin DoDot:2

 +18                       SET ABM("ID")=$SELECT(ABM("I")=32:33,ABM("I")=34:33,1:31)

                       End DoDot:2

 +19               SET ABM("TB")=$SELECT(ABM("I")<33:1,ABM("I")<35:3,ABM("I")<37:2,1:4)

 +20      ;end new code HEAT46087

 +21               SET ABM(9)=""

 +22      ;S ABM("DIAG")=$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,2)  ; CSV-c  ;abm*2.6*14 update API call

 +23      ; CSV-c  ;abm*2.6*14 update API call

                   SET ABM("DIAG")=$PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)

 +24      ;I $P($G(^AUTNINS(ABMP("INS"),0)),U)="PHC MEDICAID" S ABM("DIAG")=$TR($P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,2),".")  ;abm*2.6*11 IHS/SD/AML 3/31/2011 HEAT30524 - REMOVE DECIMAL FOR PARTNERSHIP  ;abm*2.6*14 update API call

 +25      ;abm*2.6*11 IHS/SD/AML 3/31/2011 HEAT30524 - REMOVE DECIMAL FOR PARTNERSHIP  ;abm*2.6*14 update API call

                   IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="PHC MEDICAID"

                       SET ABM("DIAG")=$TRANSLATE($PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2),".")

 +26      ;start old code abm*2.6*9 HEAT46087

 +27      ;S ABM("DIAG")=$S(ABM("I")=35:"5. "_ABM("DIAG"),ABM("I")=36:"6. "_ABM("DIAG"),ABM("I")=37:"7. "_ABM("DIAG"),ABM("I")=38:"8. "_ABM("DIAG"),1:ABM("DIAG"))  ;abm*2.6*4 HEAT12115

 +28      ;end old code start new code HEAT46087

 +29               IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,16)=8

                       Begin DoDot:2

 +30      ;abm*2.6*4 HEAT12115

                           SET ABM("DIAG")=$SELECT(ABM("I")=35:"5. "_ABM("DIAG"),ABM("I")=36:"6. "_ABM("DIAG"),ABM("I")=37:"7. "_ABM("DIAG"),ABM("I")=38:"8. "_ABM("DIAG"),1:ABM("DIAG"))

                       End DoDot:2

 +31      ;end new code HEAT46087

 +32      ;I ABMP("ITYPE")'="R",(ABM("I")>34) Q  ;abm*2.6*6 HEAT12115  ;abm*2.6*9 HEAT46087

 +33               SET $PIECE(ABMF(ABM("ID")),U,ABM("TB"))=ABM("DIAG")_" "_ABM(9)

 +34               SET ABMP("DX",ABM("DIAG"))=ABM("I")-30

               End DoDot:1

 +35      ;

ST         SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","

 +1        SET ABMPRINT=1

           DO ^ABMDESM1

 +2        IF $PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3"

               Begin DoDot:1

 +3                SET ABMI=0

 +4                FOR 

                       SET ABMI=$ORDER(ABMS(ABMI))

                       IF 'ABMI

                           QUIT 

                       Begin DoDot:2

 +5                        IF $PIECE($PIECE(ABMS(ABMI),U,4),"-",2)="QL"

                               SET ABMQLFLG=1

 +6                        SET ABMODMOD=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)

                       End DoDot:2

 +7                SET ABMI=0

 +8                FOR 

                       SET ABMI=$ORDER(ABMS(ABMI))

                       IF 'ABMI

                           QUIT 

                       Begin DoDot:2

 +9                        IF $GET(ABMQLFLG)=1

                               IF ($PIECE($PIECE(ABMS(ABMI),U,4)," ",2)'="QL")

                                   SET $PIECE(ABMS(ABMI),U,4)=$PIECE($PIECE(ABMS(ABMI),U,4)," ")

 +10      ;I $G(ABMQLFLG)'=1 S $P(ABMS(ABMI),U,4)=$P($P(ABMS(ABMI),U,4)," ")_$P($P(ABMS(ABMI),U,4)," ",2)_"  "_ABMODMOD  ;abm*2.6*1 HEAT5612

 +11      ;abm*2.6*1 HEAT5612

                           IF $GET(ABMQLFLG)'=1

                               SET $PIECE(ABMS(ABMI),U,4)=$PIECE(ABMS(ABMI),U,4)_"  "_ABMODMOD

                       End DoDot:2

               End DoDot:1

 +12       KILL ABMQLFLG

HCFA      ;

 +1        IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U)=0

               SET ABMS("TOT")=0

 +2       ;set EMG flag

           DO EMG^ABMDF27E

 +3        SET ABMS=0

 +4        FOR 

               SET ABMS=$ORDER(ABMS(ABMS))

               IF +ABMS=0

                   QUIT 

               Begin DoDot:1

 +5                SET ABMLN=2

 +6                DO PROC^ABMDF27E

 +7                SET ABMLN=ABMLN+1

               End DoDot:1

 +8        SET ABMLN=0

           SET ABMPRT=0

 +9        FOR ABMS("I")=37:2:47

               Begin DoDot:1

 +10               SET ABMLN=$ORDER(ABMR(ABMLN))

 +11               IF +ABMLN=0

                       QUIT 

 +12               SET ABMPRT=0

 +13               IF (($ORDER(ABMR(ABMLN,9),-1))+(ABMS("I")))>49

                       QUIT 

 +14               FOR 

                       SET ABMPRT=$ORDER(ABMR(ABMLN,ABMPRT))

                       IF +ABMPRT=0

                           QUIT 

                       Begin DoDot:2

 +15                       MERGE ABMF($SELECT(ABMPRT=1:(ABMS("I")-1),1:ABMS("I")))=ABMR(ABMLN,ABMPRT)

 +16                       KILL ABMR(ABMLN,ABMPRT)

                       End DoDot:2

               End DoDot:1

               IF $GET(ABM("QUIT"))

                   QUIT 

 +17      ;

 +18       DO PREV^ABMDFUTL

 +19       SET ABM("RATIO")=+^ABMDBILL(DUZ(2),ABMP("BDFN"),2)/$SELECT($PIECE(^(2),U,3):$PIECE(^(2),U,3),1:1)

 +20       IF ABM("RATIO")>1

               SET ABM("RATIO")=1

 +21       SET ABM("W")=+$FNUMBER(ABMP("WO")*ABM("RATIO"),"",2)

 +22       IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,17)="DO"

               Begin DoDot:1

 +23               SET $PIECE(ABMF(49),U,8)=+$FNUMBER(ABMP("PD")*ABM("RATIO"),"",2)+ABM("W")

               End DoDot:1

 +24       SET ABM("OB")=ABMS("TOT")-$PIECE(ABMF(49),U,8)

 +25       IF ABM("OB")<0

               SET ABM("OB")=0

 +26       SET ABM("YTOT")=ABM("OB")

 +27       DO YTOT^ABMDFUTL

 +28      ; Total Charges

           SET $PIECE(ABMF(49),U,7)=ABMS("TOT")

 +29       IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,17)="DO"

               Begin DoDot:1

 +30               SET $PIECE(ABMF(49),U,8)=+$FNUMBER(ABMP("PD"),"",2)

               End DoDot:1

 +31      ; Amount Due

 +32       IF $DATA(ABMP("BILL"))

               SET $PIECE(ABMF(49),U,9)=+$FNUMBER(ABMP("BILL"),"",2)

 +33      IF '$TEST

               SET $PIECE(ABMF(49),U,9)=+$FNUMBER(ABMS("TOT")-ABMP("PD"),"",2)-$GET(ABMP("PENS"))-$GET(ABMP("NONC"))

 +34       KILL ABMS

 +35       IF $DATA(ABMR)

               Begin DoDot:1

 +36               SET ABMR("TOT")=$PIECE(ABMF(49),U,7,9)

 +37               SET $PIECE(ABMF(49),U,7)=""

                   SET $PIECE(ABMF(49),U,8)=""

                   SET $PIECE(ABMF(49),U,9)=""

               End DoDot:1

 +38      ;

PRV       ; Provider Info

 +1        IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),"^",17)=3

               Begin DoDot:1

 +2                SET ABM("SIGN")=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",7)

 +3                IF ABM("SIGN")=""

                       Begin DoDot:2

 +4                        SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))

                           Begin DoDot:3

 +5                            IF 'ABM("X")

                                   QUIT 

 +6                            DO SELBILL^ABMDE4X

 +7                            SET ABM("SIGN")=$PIECE(ABM("A"),U,2)

                           End DoDot:3

                       End DoDot:2

 +8               IF '$TEST

                       Begin DoDot:2

 +9                        SET ABM("A")=$PIECE($GET(^VA(200,+ABM("SIGN"),20)),"^",2)_"^"_+ABM("SIGN")

                       End DoDot:2

               End DoDot:1

               GOTO PDT

 +10       IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,17)=2

               Begin DoDot:1

               End DoDot:1

               GOTO PDT

 +11       SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))

           Begin DoDot:1

 +12           IF 'ABM("X")

                   QUIT 

 +13           DO SELBILL^ABMDE4X

 +14           SET $PIECE(ABMF(52),U)=$PIECE($GET(^VA(200,+$PIECE(ABM("A"),"^",2),20)),"^",2)

 +15           IF $PIECE(ABMF(52),U)=""

                   SET $PIECE(ABMF(52),U)=$PIECE(ABM("A"),U)

           End DoDot:1

PDT       ;S $P(ABMF(54),U)=DT  ;abm*2.6*2 FIXPMS10006

 +1       ;S $P(ABMF(54),U)=$S($G(ABMPDT)="O":$P($G(^ABMDTXST(DUZ(2),+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),1:DT)  ;abm*2.6*2 FIXPMS10006  ;abm*2.6*4 HEAT17615

 +2       ;S $P(ABMF(54),U)=$S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),1:DT)  ;abm*2.6*2 FIXPMS10006  ;abm*2.6*4 HEAT17615  ;abm*2.6*11 HEAT81561

 +3       ;abm*2.6*11 HEAT81561

           SET $PIECE(ABMF(54),U)=$SELECT($GET(ABMP("PRINTDT"))="O":$PIECE($GET(^ABMDTXST(DUZ(2),+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),$GET(ABMP("PRINTDT"))="A":$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5),1:DT)

 +4        IF $DATA(ABM("A"))

               Begin DoDot:1

 +5                SET ABM("PRO")=$PIECE(ABM("A"),U,2)

 +6                SET $PIECE(ABMF(54),U,4)=$SELECT($PIECE($$NPI^XUSNPI("Individual_ID",ABM("PRO")),U)>0:$PIECE($$NPI^XUSNPI("Individual_ID",ABM("PRO")),U),1:"")

 +7               SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":...

                   ... $PIECE(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))

 +8                SET $PIECE(ABMF(54),U,4)=$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)

 +9                SET ABMPQ=$SELECT(ABMP("ITYPE")="R":"1C",ABMP("ITYPE")="D":"1D",$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$PIECE($GET(^ABMREFID($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"

0B")

 +10               IF $GET(ABMPQ)=""

                       SET ABMPQ="G2"

 +11               IF ($GET(ABMP("NPIS"))'="")&($GET(ABMP("NPIS"))'="N")

                       SET $PIECE(ABMF(54),U,5)=$GET(ABMPQ)_$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)

 +12               IF ($GET(ABMP("NPIS"))'="")&($GET(ABMP("NPIS"))'="N")

                       SET $PIECE(ABMF(54),U,5)="ZZ"_$$PTAX^ABMEEPRV(ABM("PRO"))

               End DoDot:1

 +13       IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["ALASKA MEDICAID"

               Begin DoDot:1

 +14      ;only change for POS 22

                   IF $PIECE($GET(ABMF(37)),U,3)'=22

                       QUIT 

 +15               SET $PIECE(ABMF(54),U,4)="982808978"

                   SET $PIECE(ABMF(54),U,5)="1DCL461"

               End DoDot:1

 +16      ;

XIT        KILL ABM,ABMV,ABMX,ABMPRINT

 +1        QUIT