ABMPTSMT ; IHS/SD/SDR - Non-ben patient statement ;
;;2.6;IHS 3P BILLING SYSTEM;**3,10,11,13,21**;NOV 12, 2009;Build 379
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*p21 - HEAT116546 - shorten stmt by 5 lines to fit on 1 page
;
MARG ;Set left and top margins
S (ABM("LM"),ABM("TM"),ABM("LN"))=0
W $$EN^ABMVDF("IOF")
I +ABM("TM") F ABM("I")=1:1:ABM("TM") W !
S ABMP("PDFN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
S ABMP("LDFN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,3)
S ABMP("VTYP")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,7)
S ABMP("BTYP")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,2)
S ABMP("INS")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)
S (ABMP("ITYP"),ABMP("ITYPE"))=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I") ;abm*2.6*21 IHS/SD/SDR HEAT116546
S ABMP("CLIN")=$P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)
S ABMP("VDT")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
S ABMP("EXP")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,6) ;abm*2.6*10 HEAT72987
S ABMPAGE=1
S ABMTCHRG=0
D HDR
D SLINES
D XIT
Q
;
HDR ;
;main header
W !!
S ABMADIEN=$O(^AUTTLOC(DUZ(2),11,9999999),-1)
I $P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)=1 D CENTER("DEPARTMENT OF HEALTH & HUMAN SERVICES")
W !
I $P($G(^ABMDPARM(DUZ(2),1,2)),U,11)'="" D CENTER($P($G(^ABMDPARM(DUZ(2),1,2)),U,11))
E D CENTER("INDIAN HEALTH SERVICE")
W !!
;visit location
D CENTER($P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2))
W !!!
D CENTER("STATEMENT OF SERVICES")
W !!!!
;claim data header
;
D GUARCHK ;check if guarantor; default to patient if none for DOS
W ?5,"DATE : ",$$SDT^ABMDUTL(DT)
W ?45,ABMGNAME
W !
W ?5,"CHART #: "
W $S($P($G(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2)'="":$P(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0),U,2),1:$P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2))
W ?45,ABMGSTR
W !
W ?5,"REF # : ",$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)
W ?45,ABMGCITY_", "_ABMGST_" "_ABMGZIP
W !!!,?1
F ABMI=1:1:78 W "-"
W !,?1
F ABMI=1:1:78 W "="
W !
; statement header
W ?1,"|PATIENT NAME: ",$E($P($G(^DPT($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5),0)),U),1,38)
W ?40,"|SERVICE DATE: ",$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U))
W ?68,"|PAGE: ",$$FMT^ABMERUTL(ABMPAGE,"3NR")_"|"
W !,?1
F ABMI=1:1:78 W "-"
W !
W ?1,"|VISIT TYPE: ",$P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)
S ABMAPRV=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
I ABMAPRV="" S ABMAPRV=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",0))
I ABMAPRV'="" S ABMAPRV=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMAPRV,0)),U)
W ?39,"|ATTENDING PHYSICIAN: ",$S(ABMAPRV'="":$E($P($G(^VA(200,ABMAPRV,0)),U),1,17),1:"(NO ATTENDING)")_"|"
W !,?1
F ABMI=1:1:78 W "="
W !
W ?1,"|SERVICE |SERVICE |",?63,"|",?67,"|",?78,"|"
W !
W ?1,"|DATE",?10,"|CODE |DESCRIPTION"
W ?63,"|QTY|AMOUNT |"
W !
W ?1,"|--------|---------|------------------------------------------"
W "|---|----------|"
W !
Q
SLINES ;service lines
D ^ABMEHGRV
I $G(ABMP("FLAT"))'="" D Q
.S ABMSDT=$$SDTO^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U))
.S ABMSCD=$P(ABMP("FLAT"),U,2)
.S ABMDESC=$S($P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,9)'="":$P(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,9),1:$P($G(^AUTTREVN($P(ABMP("FLAT"),U,2),0)),U,2))
.S ABMUNIT=$P(ABMP("FLAT"),U,3)
.S ABMCHRG=$P(ABMP("FLAT"),U)*ABMUNIT
.S ABMTCHRG=$G(ABMTCHRG)+ABMCHRG
.S ABMCHRG=$FN($J(ABMCHRG,".",2),",",2)
.D WLINE
.D TOTAL
;
S ABMLNCNT=0
;abm*2.6*11 HEAT71638 - changed all ABMI references in next section to ABMII
;variable was being changed when new page started causing lines to not print
S (ABMII,ABMJ,ABMK)=0
F S ABMII=$O(ABMRV(ABMII)) Q:+ABMII=0 D
.S ABMJ=0
.F S ABMJ=$O(ABMRV(ABMII,ABMJ)) Q:+ABMJ=0 D
..S ABMK=0
..F S ABMK=$O(ABMRV(ABMII,ABMJ,ABMK)) Q:+ABMK=0 D
...S ABMSDT=$$SDTO^ABMDUTL($S($P(ABMRV(ABMII,ABMJ,ABMK),U,27)'="":+$P(ABMRV(ABMII,ABMJ,ABMK),U,27),1:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)))
...S ABMSCD=$P($G(ABMRV(ABMII,ABMJ,ABMK)),U,2)
...I ABMII=23 D
....S ABMSCD=$P($G(ABMRV(ABMII,ABMJ,ABMK)),U,13) ;pharmacy RX
....S ABMSDT=$$SDTO^ABMDUTL($S($P(ABMRV(ABMII,ABMJ,ABMK),U,10)'="":+$P(ABMRV(ABMII,ABMJ,ABMK),U,10),1:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)))
...;I ABMI=25 S ABMSCD=$P($G(ABMRV(ABMII,ABMJ,ABMK)),U) ;Rev code ;abm*2.6*21 IHS/SD/SDR HEAT116546
...I ABMII=25 S ABMSCD=$P($G(ABMRV(ABMII,ABMJ,ABMK)),U) ;Rev code ;abm*2.6*21 IHS/SD/SDR HEAT116546
...S ABMDESC=$P($G(ABMRV(ABMII,ABMJ,ABMK)),U,9)
...I ABMII'=23&(ABMII'=33)&(ABMII'=25),($P(ABMRV(ABMII,ABMJ,ABMK),U,2)'="") S ABMDESC=$P($$CPT^ABMCVAPI(+$P(ABMRV(ABMII,ABMJ,ABMK),U,2),ABMP("VDT")),U,3) ;CSV-c
...;I ABMI'=33&($A($E($P(ABMRV(ABMI,ABMJ,ABMK),U,2)))>64) S ABMDESC=$P($$CPT^ABMCVAPI($O(^ICPT("B",$P(ABMRV(ABMI,ABMJ,ABMK),U,2),0)),ABMP("VDT")),U,3) ;CSV-c ;abm*2.6*10
...I ABMII'=33&(ABMII'=23)&($A($E($P(ABMRV(ABMII,ABMJ,ABMK),U,2)))>64) S ABMDESC=$P($$CPT^ABMCVAPI($O(^ICPT("B",$P(ABMRV(ABMII,ABMJ,ABMK),U,2),0)),ABMP("VDT")),U,3) ;CSV-c ;abm*2.6*10
...I ABMII=33&($A($E($P(ABMRV(ABMII,ABMJ,ABMK),U,2)))>64) S ABMDESC=$P($G(^AUTTADA($O(^AUTTADA("B",$E($P(ABMRV(ABMII,ABMJ,ABMK),U,2),2,5),0)),0)),U,2)
...I ABMII=25 S ABMDESC=$P($G(^AUTTREVN($P(ABMRV(ABMII,ABMJ,ABMK),U),0)),U,2) ;rev code desc
...S ABMUNIT=$P($G(ABMRV(ABMII,ABMJ,ABMK)),U,5) ;units--ok for all
...S ABMCHRG=$P($G(ABMRV(ABMII,ABMJ,ABMK)),U,6) ;charges--ok for all
...S ABMTCHRG=$G(ABMTCHRG)+ABMCHRG
...S ABMCHRG=$FN($J(ABMCHRG,".",2),",",2)
...D WLINE
D TOTAL
Q
;
WLINE ;write service line
W ?1,"|",ABMSDT,"|"
W $$FMT^ABMERUTL(ABMSCD,"9R"),"|"
W $$FMT^ABMERUTL(ABMDESC,"42L"),"|"
W $$FMT^ABMERUTL(ABMUNIT,"3R"),"|"
W $$FMT^ABMERUTL(ABMCHRG,"10R"),"|"
W !
S ABMLNCNT=+$G(ABMLNCNT)+1
I ABMLNCNT>17 D ;start new page
.W ?1,"|"
.W ?10,"|"
.W ?20,"|"
.W ?50,"CONTINUED==>"
.W ?63,"|"
.W ?67,"| |"
.W !
.D WCOVRG
.S ABMPAGE=ABMPAGE+1
.D HDR
.S ABMLNCNT=1
Q
;
TOTAL ;total
W ?1,"|"
W ?10,"|"
W ?20,"|"
W ?63,"|"
W ?67,"|==========|"
W !
W ?1,"|"
W ?10,"|"
W ?20,"|"
W ?50,"TOTAL CHARGES|"
W ?67,"|",$J($FN(ABMTCHRG,",",2),10),"|",!
;I ABMLNCNT<20 D ;abm*2.6*21 IHS/SD/SDR HEAT116546
I ABMLNCNT<15 D ;abm*2.6*21 IHS/SD/SDR HEAT116546
.S ABMLN=" | | | | | |"
.;F ABMLNCNT=ABMLNCNT:1:20 W ABMLN,! ;abm*2.6*21 IHS/SD/SDR HEAT116546
.F ABMLNCNT=ABMLNCNT:1:15 W ABMLN,! ;abm*2.6*21 IHS/SD/SDR HEAT116546
;
WCOVRG ; coverage info from bill
D COVRG
W ?1
F ABMI=1:1:78 W "-"
W !?1,"Your coverage on file is:"
S (ABMPRI,ABMPRIS,ABMINS)=0
F S ABMPRI=$O(ABML(ABMPRI)) Q:+ABMPRI=0!(ABMPRI>3) D
.S ABMPRIS=ABMPRI
.S ABMINS=0
.F S ABMINS=$O(ABML(ABMPRI,ABMINS)) Q:+ABMINS=0 D
..Q:$P($G(^AUTNINS(ABMINS,0)),U)["NON-BEN" ;don't print non-ben insurer
..W !?1,ABMPRI_". ",?3,$E($P($G(^AUTNINS(ABMINS,0)),U),1,35)
..I $P($G(ABML(ABMPRI,ABMINS)),U)'="" W ?40,$E($P($G(^AUTTPIC($P($G(ABML(ABMPRI,ABMINS)),U),0)),U),1,23)
..I $P($G(ABML(ABMPRI,ABMINS)),U,2) W ?65,"Eff: "_$$SDT^ABMDUTL($P($G(ABML(ABMPRI,ABMINS)),U,2))
I +$O(ABML(0))=0 W ?10,"NO COVERAGE FOUND"
I ABMPRIS<3 D
.F ABMPRIS=ABMPRIS:1:3 W !
;
W !!?1
F ABMI=1:1:78 W "-"
W !?1,"|"
;W $G(ABMY(ABMP("BDFN")))_$S($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7)'="":" ("_$$SDT^ABMDUTL($P($G(^ABMDTXST(DUZ(2),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0)),U))_")",1:"") ;abm*2.6*3
W $G(ABMY(ABMP("BDFN")))_$S($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7)'=""&($P($G(^ABMDPARM(DUZ(2),1,2)),U,14)="Y"):" ("_$$SDT^ABMDUTL($P($G(^ABMDTXST(DUZ(2),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0)),U))_")",1:"") ;abm*2.6*3
W ?78,"|"
W !?1
F ABMI=1:1:78 W "-"
;
D LOC^ABMDE1X1
W !,?1
W "Payments or inquiries may be sent to: "
W ?50,$P($P($G(ABMV("X1")),U),";",2)
W !?50,$P($G(ABMV("X1")),U,3)
W !?50,$P($G(ABMV("X1")),U,4)
W !!?50,$P($G(ABMV("X1")),U,5)
W !
D PRTFILE ;files message and who printed
Q
PRTFILE ; EP - save message, date, and who printed statement
K X,Y,DIC,DIE,DA
S DA(1)=ABMP("BDFN")
S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",67,"
S DIC(0)="LM"
S DIC("P")=$P(^DD(9002274.4,67,0),U,2)
D NOW^%DTC
S X=%
S DIC("DR")=".02////"_DUZ_";.03////"_$G(ABMY(ABMP("BDFN")))
D ^DIC
Q
XIT ;
K ABMV
K ABMGNAME,ABMGSTR,ABMGCITY,ABMGST,ABMGZIP
K ABMI,ABMJ,ABMK,ABMPRI,ABMINS,ABMRV,ABML
K ABMSDT,ABMSCD,ABMDESC,ABMUNIT,ABMCHRG,ABMTCHRG
K ABMLNCNT,ABMNOG,ABMPAGE,ABMMSG
Q
;
GUARCHK ; set vars for header
;guarantor if there is one
;default to patient
S ABMNOG=0 ;stays 0 if no guarantor entry found for DOS
I +$O(^AUPNGUAR(ABMP("PDFN"),1,0))'=0 D
.S ABMSDTTO=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
.S ABMSDTFR=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,2)
.S ABMGIEN=0
.F S ABMGIEN=$O(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN)) Q:+ABMGIEN=0 D
..S ABMGEFDA=0
..F S ABMGEFDA=$O(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN,11,ABMGEFDA)) Q:+ABMGEFDA=0 D
...S ABMGEFDT=$P($G(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN,11,ABMGEFDA,0)),U)
...S ABMGENDT=$P($G(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN,11,ABMGEFDA,0)),U,2)
...I ABMGEFDT>ABMSDTTO!(ABMGENDT>ABMSDTFR) Q
...S ABMNOG=1
...S ABMG=$P($G(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN,0)),U)
...S ABMGDA=$P(ABMG,";"),ABMGFILE=$P(ABMG,";",2)
...I ABMGFILE["AUPNPAT" D
....S ABMGNAME=$E($P($G(^DPT(ABMGDA,0)),U),1,50)
....S ABMGSTR=$P($G(^DPT(ABMGDA,.11)),U)
....S ABMGCITY=$P($G(^DPT(ABMGDA,.11)),U,4)
....S ABMGST=$S($P($G(^DPT(ABMGDA,.11)),U,5)'="":$P($G(^DIC(5,$P($G(^DPT(ABMGDA,.11)),U,5),0)),U,2),1:"")
....S ABMGZIP=$P($G(^DPT(ABMGDA,.11)),U,6)
...I ABMGFILE["AUTNINS" D
....S ABMGNAME=$P($G(^AUTNINS(ABMGDA,0)),U)
....S ABMGSTR=$P($G(^AUTNINS(ABMGDA,0)),U,2)
....S ABMGCITY=$P($G(^AUTNINS(ABMGDA,0)),U,3)
....S ABMGST=$S($P($G(^AUTNINS(ABMGDA,0)),U,4)'="":$P($G(^DIC(5,$P($G(^AUTNINS(ABMGDA,0)),U,4),0)),U,2),1:"")
....S ABMGZIP=$P($G(^AUTNINS(ABMGDA,0)),U,5)
...I ABMGFILE["AUTNEMPL" D
....S ABMGNAME=$E($P($G(^AUTNEMPL(ABMGDA,0)),U),1,50)
....S ABMGSTR=$P($G(^AUTNEMPL(ABMGDA,0)),U,2)
....S ABMGCITY=$P($G(^AUTNEMPL(ABMGDA,0)),U,3)
....S ABMGST=$S($P($G(^AUTNEMPL(ABMGDA,0)),U,4)'="":$P($G(^DIC(5,$P($G(^AUTNEMPL(ABMGDA,0)),U,4),0)),U,2),1:"")
....S ABMGZIP=$P($G(^AUTNEMPL(ABMGDA,0)),U,5)
;default to patient
I +$O(^AUPNGUAR(ABMP("PDFN"),1,0))=0!(ABMNOG=0) D
.S ABMGNAME=$E($P($G(^DPT(ABMP("PDFN"),0)),U),1,50)
.S ABMGSTR=$P($G(^DPT(ABMP("PDFN"),.11)),U)
.S ABMGCITY=$P($G(^DPT(ABMP("PDFN"),.11)),U,4)
.S ABMGST=$S($P($G(^DPT(ABMP("PDFN"),.11)),U,5)'="":$P($G(^DIC(5,$P($G(^DPT(ABMP("PDFN"),.11)),U,5),0)),U,2),1:"")
.S ABMGZIP=$P($G(^DPT(ABMP("PDFN"),.11)),U,6)
Q
COVRG ;EP
K ABML
K ABMBEN
S ABMIEN=0,ABMISNB=0,ABMBILLD=0
F S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMIEN)) Q:+ABMIEN=0 D
.S (ABMINTRY,ABMCOV,ABMEFDT)=""
.S ABMX=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMIEN,0))
.I $P(ABMX,U,3)="C" S ABMBILLD=1 ;completed; don't print if doing batch
.S ABMINS=$P(ABMX,U)
.;I $P($G(^AUTNINS(ABMINS,2)),U)="N"!($P($G(^AUTNINS(ABMINS,0)),U)["NON-BEN") S ABMISNB=1 ;abm*2.6*10 HEAT73780
.I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMINS,".211","I"),1,"I")="N"!($P($G(^AUTNINS(ABMINS,0)),U)["NON-BEN") S ABMISNB=1 ;abm*2.6*10 HEAT73780
.S ABMPRI=$P(ABMX,U,2)
.I ($P($G(^AUTNINS(ABMINS,0)),U)="BENEFICIARY PATIENT"),($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)=ABMINS) S ABMABEN=1
.I ($P($G(^AUTNINS(ABMINS,0)),U)="BENEFICIARY PATIENT") S ABMBEN=1 Q
.I $P($G(^AUPNPAT(ABMP("PDFN"),11)),U,12)'="I" S ABMBEN=1
.I $P(ABMX,U,4)'="" D ;Medicare
..S ABMINTRY=$G(^AUPNMCR(ABMP("PDFN"),11,$P(ABMX,U,4),0))
..S ABMEFDT=$P(ABMINTRY,U)
..S ABMCOV=$P(ABMINTRY,U,3)
.I $P(ABMX,U,5)'="" D ;Railroad
..S ABMINTRY=$G(^AUPNRRE(ABMP("PDFN"),11,$P(ABMX,U,5),0))
..S ABMEFDT=$P(ABMINTRY,U)
..S ABMCOV=$P(ABMINTRY,U,3)
.I $P(ABMX,U,6)'="" D ;Medicaid
..S ABMMULT=$P(ABMX,U,7)
..Q:ABMMULT=""
..S ABMINTRY=$G(^AUPNMCD($P(ABMX,U,6),11,ABMMULT,0))
..S ABMEFDT=$P(ABMINTRY,U)
..S ABMCOV=$P(ABMINTRY,U,3)
.I $P(ABMX,U,8)'="" D ;PI
..S ABMINTRY=$G(^AUPNPRVT(ABMP("PDFN"),11,$P(ABMX,U,8),0))
..S ABMEFDT=$P(ABMINTRY,U,6)
..S ABMPH=$P(ABMINTRY,U,8)
..S:+ABMPH ABMCOV=$P($G(^AUPN3PPH(ABMPH,0)),U,5)
.S ABML(ABMPRI,ABMINS)=$G(ABMCOV)_"^"_ABMEFDT
Q
CENTER(X) ;EP
S CENTER=IOM/2
W ?CENTER-($L(X)/2),X
Q
ABMPTSMT ; IHS/SD/SDR - Non-ben patient statement ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,10,11,13,21**;NOV 12, 2009;Build 379
+2 ;
+3 ; IHS/SD/SDR - v2.6 CSV
+4 ;IHS/SD/SDR - 2.6*p21 - HEAT116546 - shorten stmt by 5 lines to fit on 1 page
+5 ;
MARG ;Set left and top margins
+1 SET (ABM("LM"),ABM("TM"),ABM("LN"))=0
+2 WRITE $$EN^ABMVDF("IOF")
+3 IF +ABM("TM")
FOR ABM("I")=1:1:ABM("TM")
WRITE !
+4 SET ABMP("PDFN")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
+5 SET ABMP("LDFN")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,3)
+6 SET ABMP("VTYP")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,7)
+7 SET ABMP("BTYP")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,2)
+8 SET ABMP("INS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)
+9 ;abm*2.6*21 IHS/SD/SDR HEAT116546
SET (ABMP("ITYP"),ABMP("ITYPE"))=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")
+10 SET ABMP("CLIN")=$PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)
+11 SET ABMP("VDT")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+12 ;abm*2.6*10 HEAT72987
SET ABMP("EXP")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,6)
+13 SET ABMPAGE=1
+14 SET ABMTCHRG=0
+15 DO HDR
+16 DO SLINES
+17 DO XIT
+18 QUIT
+19 ;
HDR ;
+1 ;main header
+2 WRITE !!
+3 SET ABMADIEN=$ORDER(^AUTTLOC(DUZ(2),11,9999999),-1)
+4 IF $PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)=1
DO CENTER("DEPARTMENT OF HEALTH & HUMAN SERVICES")
+5 WRITE !
+6 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,11)'=""
DO CENTER($PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,11))
+7 IF '$TEST
DO CENTER("INDIAN HEALTH SERVICE")
+8 WRITE !!
+9 ;visit location
+10 DO CENTER($PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2))
+11 WRITE !!!
+12 DO CENTER("STATEMENT OF SERVICES")
+13 WRITE !!!!
+14 ;claim data header
+15 ;
+16 ;check if guarantor; default to patient if none for DOS
DO GUARCHK
+17 WRITE ?5,"DATE : ",$$SDT^ABMDUTL(DT)
+18 WRITE ?45,ABMGNAME
+19 WRITE !
+20 WRITE ?5,"CHART #: "
+21 WRITE $SELECT($PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2)'="":$PIECE(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0),U,2),1:$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2))
+22 WRITE ?45,ABMGSTR
+23 WRITE !
+24 WRITE ?5,"REF # : ",$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)
+25 WRITE ?45,ABMGCITY_", "_ABMGST_" "_ABMGZIP
+26 WRITE !!!,?1
+27 FOR ABMI=1:1:78
WRITE "-"
+28 WRITE !,?1
+29 FOR ABMI=1:1:78
WRITE "="
+30 WRITE !
+31 ; statement header
+32 WRITE ?1,"|PATIENT NAME: ",$EXTRACT($PIECE($GET(^DPT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5),0)),U),1,38)
+33 WRITE ?40,"|SERVICE DATE: ",$$SDT^ABMDUTL($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U))
+34 WRITE ?68,"|PAGE: ",$$FMT^ABMERUTL(ABMPAGE,"3NR")_"|"
+35 WRITE !,?1
+36 FOR ABMI=1:1:78
WRITE "-"
+37 WRITE !
+38 WRITE ?1,"|VISIT TYPE: ",$PIECE($GET(^ABMDVTYP(ABMP("VTYP"),0)),U)
+39 SET ABMAPRV=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
+40 IF ABMAPRV=""
SET ABMAPRV=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",0))
+41 IF ABMAPRV'=""
SET ABMAPRV=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMAPRV,0)),U)
+42 WRITE ?39,"|ATTENDING PHYSICIAN: ",$SELECT(ABMAPRV'="":$EXTRACT($PIECE($GET(^VA(200,ABMAPRV,0)),U),1,17),1:"(NO ATTENDING)")_"|"
+43 WRITE !,?1
+44 FOR ABMI=1:1:78
WRITE "="
+45 WRITE !
+46 WRITE ?1,"|SERVICE |SERVICE |",?63,"|",?67,"|",?78,"|"
+47 WRITE !
+48 WRITE ?1,"|DATE",?10,"|CODE |DESCRIPTION"
+49 WRITE ?63,"|QTY|AMOUNT |"
+50 WRITE !
+51 WRITE ?1,"|--------|---------|------------------------------------------"
+52 WRITE "|---|----------|"
+53 WRITE !
+54 QUIT
SLINES ;service lines
+1 DO ^ABMEHGRV
+2 IF $GET(ABMP("FLAT"))'=""
Begin DoDot:1
+3 SET ABMSDT=$$SDTO^ABMDUTL($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U))
+4 SET ABMSCD=$PIECE(ABMP("FLAT"),U,2)
+5 SET ABMDESC=$SELECT($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,9)'="":$PIECE(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,9),1:$PIECE($GET(^AUTTREVN($PIECE(ABMP("FLAT"),U,2),0)),U,2))
+6 SET ABMUNIT=$PIECE(ABMP("FLAT"),U,3)
+7 SET ABMCHRG=$PIECE(ABMP("FLAT"),U)*ABMUNIT
+8 SET ABMTCHRG=$GET(ABMTCHRG)+ABMCHRG
+9 SET ABMCHRG=$FNUMBER($JUSTIFY(ABMCHRG,".",2),",",2)
+10 DO WLINE
+11 DO TOTAL
End DoDot:1
QUIT
+12 ;
+13 SET ABMLNCNT=0
+14 ;abm*2.6*11 HEAT71638 - changed all ABMI references in next section to ABMII
+15 ;variable was being changed when new page started causing lines to not print
+16 SET (ABMII,ABMJ,ABMK)=0
+17 FOR
SET ABMII=$ORDER(ABMRV(ABMII))
IF +ABMII=0
QUIT
Begin DoDot:1
+18 SET ABMJ=0
+19 FOR
SET ABMJ=$ORDER(ABMRV(ABMII,ABMJ))
IF +ABMJ=0
QUIT
Begin DoDot:2
+20 SET ABMK=0
+21 FOR
SET ABMK=$ORDER(ABMRV(ABMII,ABMJ,ABMK))
IF +ABMK=0
QUIT
Begin DoDot:3
+22 SET ABMSDT=$$SDTO^ABMDUTL($SELECT($PIECE(ABMRV(ABMII,ABMJ,ABMK),U,27)'="":+$PIECE(ABMRV(ABMII,ABMJ,ABMK),U,27),1:$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)))
+23 SET ABMSCD=$PIECE($GET(ABMRV(ABMII,ABMJ,ABMK)),U,2)
+24 IF ABMII=23
Begin DoDot:4
+25 ;pharmacy RX
SET ABMSCD=$PIECE($GET(ABMRV(ABMII,ABMJ,ABMK)),U,13)
+26 SET ABMSDT=$$SDTO^ABMDUTL($SELECT($PIECE(ABMRV(ABMII,ABMJ,ABMK),U,10)'="":+$PIECE(ABMRV(ABMII,ABMJ,ABMK),U,10),1:$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)))
End DoDot:4
+27 ;I ABMI=25 S ABMSCD=$P($G(ABMRV(ABMII,ABMJ,ABMK)),U) ;Rev code ;abm*2.6*21 IHS/SD/SDR HEAT116546
+28 ;Rev code ;abm*2.6*21 IHS/SD/SDR HEAT116546
IF ABMII=25
SET ABMSCD=$PIECE($GET(ABMRV(ABMII,ABMJ,ABMK)),U)
+29 SET ABMDESC=$PIECE($GET(ABMRV(ABMII,ABMJ,ABMK)),U,9)
+30 ;CSV-c
IF ABMII'=23&(ABMII'=33)&(ABMII'=25)
IF ($PIECE(ABMRV(ABMII,ABMJ,ABMK),U,2)'="")
SET ABMDESC=$PIECE($$CPT^ABMCVAPI(+$PIECE(ABMRV(ABMII,ABMJ,ABMK),U,2),ABMP("VDT")),U,3)
+31 ;I ABMI'=33&($A($E($P(ABMRV(ABMI,ABMJ,ABMK),U,2)))>64) S ABMDESC=$P($$CPT^ABMCVAPI($O(^ICPT("B",$P(ABMRV(ABMI,ABMJ,ABMK),U,2),0)),ABMP("VDT")),U,3) ;CSV-c ;abm*2.6*10
+32 ;CSV-c ;abm*2.6*10
IF ABMII'=33&(ABMII'=23)&($ASCII($EXTRACT($PIECE(ABMRV(ABMII,ABMJ,ABMK),U,2)))>64)
SET ABMDESC=$PIECE($$CPT^ABMCVAPI($ORDER(^ICPT("B",$PIECE(ABMRV(ABMII,ABMJ,ABMK),U,2),0)),ABMP("VDT")),U,3)
+33 IF ABMII=33&($ASCII($EXTRACT($PIECE(ABMRV(ABMII,ABMJ,ABMK),U,2)))>64)
SET ABMDESC=$PIECE($GET(^AUTTADA($ORDER(^AUTTADA("B",$EXTRACT($PIECE(ABMRV(ABMII,ABMJ,ABMK),U,2),2,5),0)),0)),U,2)
+34 ;rev code desc
IF ABMII=25
SET ABMDESC=$PIECE($GET(^AUTTREVN($PIECE(ABMRV(ABMII,ABMJ,ABMK),U),0)),U,2)
+35 ;units--ok for all
SET ABMUNIT=$PIECE($GET(ABMRV(ABMII,ABMJ,ABMK)),U,5)
+36 ;charges--ok for all
SET ABMCHRG=$PIECE($GET(ABMRV(ABMII,ABMJ,ABMK)),U,6)
+37 SET ABMTCHRG=$GET(ABMTCHRG)+ABMCHRG
+38 SET ABMCHRG=$FNUMBER($JUSTIFY(ABMCHRG,".",2),",",2)
+39 DO WLINE
End DoDot:3
End DoDot:2
End DoDot:1
+40 DO TOTAL
+41 QUIT
+42 ;
WLINE ;write service line
+1 WRITE ?1,"|",ABMSDT,"|"
+2 WRITE $$FMT^ABMERUTL(ABMSCD,"9R"),"|"
+3 WRITE $$FMT^ABMERUTL(ABMDESC,"42L"),"|"
+4 WRITE $$FMT^ABMERUTL(ABMUNIT,"3R"),"|"
+5 WRITE $$FMT^ABMERUTL(ABMCHRG,"10R"),"|"
+6 WRITE !
+7 SET ABMLNCNT=+$GET(ABMLNCNT)+1
+8 ;start new page
IF ABMLNCNT>17
Begin DoDot:1
+9 WRITE ?1,"|"
+10 WRITE ?10,"|"
+11 WRITE ?20,"|"
+12 WRITE ?50,"CONTINUED==>"
+13 WRITE ?63,"|"
+14 WRITE ?67,"| |"
+15 WRITE !
+16 DO WCOVRG
+17 SET ABMPAGE=ABMPAGE+1
+18 DO HDR
+19 SET ABMLNCNT=1
End DoDot:1
+20 QUIT
+21 ;
TOTAL ;total
+1 WRITE ?1,"|"
+2 WRITE ?10,"|"
+3 WRITE ?20,"|"
+4 WRITE ?63,"|"
+5 WRITE ?67,"|==========|"
+6 WRITE !
+7 WRITE ?1,"|"
+8 WRITE ?10,"|"
+9 WRITE ?20,"|"
+10 WRITE ?50,"TOTAL CHARGES|"
+11 WRITE ?67,"|",$JUSTIFY($FNUMBER(ABMTCHRG,",",2),10),"|",!
+12 ;I ABMLNCNT<20 D ;abm*2.6*21 IHS/SD/SDR HEAT116546
+13 ;abm*2.6*21 IHS/SD/SDR HEAT116546
IF ABMLNCNT<15
Begin DoDot:1
+14 SET ABMLN=" | | | | | |"
+15 ;F ABMLNCNT=ABMLNCNT:1:20 W ABMLN,! ;abm*2.6*21 IHS/SD/SDR HEAT116546
+16 ;abm*2.6*21 IHS/SD/SDR HEAT116546
FOR ABMLNCNT=ABMLNCNT:1:15
WRITE ABMLN,!
End DoDot:1
+17 ;
WCOVRG ; coverage info from bill
+1 DO COVRG
+2 WRITE ?1
+3 FOR ABMI=1:1:78
WRITE "-"
+4 WRITE !?1,"Your coverage on file is:"
+5 SET (ABMPRI,ABMPRIS,ABMINS)=0
+6 FOR
SET ABMPRI=$ORDER(ABML(ABMPRI))
IF +ABMPRI=0!(ABMPRI>3)
QUIT
Begin DoDot:1
+7 SET ABMPRIS=ABMPRI
+8 SET ABMINS=0
+9 FOR
SET ABMINS=$ORDER(ABML(ABMPRI,ABMINS))
IF +ABMINS=0
QUIT
Begin DoDot:2
+10 ;don't print non-ben insurer
IF $PIECE($GET(^AUTNINS(ABMINS,0)),U)["NON-BEN"
QUIT
+11 WRITE !?1,ABMPRI_". ",?3,$EXTRACT($PIECE($GET(^AUTNINS(ABMINS,0)),U),1,35)
+12 IF $PIECE($GET(ABML(ABMPRI,ABMINS)),U)'=""
WRITE ?40,$EXTRACT($PIECE($GET(^AUTTPIC($PIECE($GET(ABML(ABMPRI,ABMINS)),U),0)),U),1,23)
+13 IF $PIECE($GET(ABML(ABMPRI,ABMINS)),U,2)
WRITE ?65,"Eff: "_$$SDT^ABMDUTL($PIECE($GET(ABML(ABMPRI,ABMINS)),U,2))
End DoDot:2
End DoDot:1
+14 IF +$ORDER(ABML(0))=0
WRITE ?10,"NO COVERAGE FOUND"
+15 IF ABMPRIS<3
Begin DoDot:1
+16 FOR ABMPRIS=ABMPRIS:1:3
WRITE !
End DoDot:1
+17 ;
+18 WRITE !!?1
+19 FOR ABMI=1:1:78
WRITE "-"
+20 WRITE !?1,"|"
+21 ;W $G(ABMY(ABMP("BDFN")))_$S($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7)'="":" ("_$$SDT^ABMDUTL($P($G(^ABMDTXST(DUZ(2),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0)),U))_")",1:"") ;abm*2.6*3
+22 ;abm*2.6*3
WRITE $GET(ABMY(ABMP("BDFN")))_$SELECT($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7)'=""&($PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,14)="Y"):" ("_$$SDT^ABMDUTL($PIECE($GET(^ABMDTXST(DUZ(2),$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0)),U))_")",1:""
)
+23 WRITE ?78,"|"
+24 WRITE !?1
+25 FOR ABMI=1:1:78
WRITE "-"
+26 ;
+27 DO LOC^ABMDE1X1
+28 WRITE !,?1
+29 WRITE "Payments or inquiries may be sent to: "
+30 WRITE ?50,$PIECE($PIECE($GET(ABMV("X1")),U),";",2)
+31 WRITE !?50,$PIECE($GET(ABMV("X1")),U,3)
+32 WRITE !?50,$PIECE($GET(ABMV("X1")),U,4)
+33 WRITE !!?50,$PIECE($GET(ABMV("X1")),U,5)
+34 WRITE !
+35 ;files message and who printed
DO PRTFILE
+36 QUIT
PRTFILE ; EP - save message, date, and who printed statement
+1 KILL X,Y,DIC,DIE,DA
+2 SET DA(1)=ABMP("BDFN")
+3 SET DIC="^ABMDBILL(DUZ(2),"_DA(1)_",67,"
+4 SET DIC(0)="LM"
+5 SET DIC("P")=$PIECE(^DD(9002274.4,67,0),U,2)
+6 DO NOW^%DTC
+7 SET X=%
+8 SET DIC("DR")=".02////"_DUZ_";.03////"_$GET(ABMY(ABMP("BDFN")))
+9 DO ^DIC
+10 QUIT
XIT ;
+1 KILL ABMV
+2 KILL ABMGNAME,ABMGSTR,ABMGCITY,ABMGST,ABMGZIP
+3 KILL ABMI,ABMJ,ABMK,ABMPRI,ABMINS,ABMRV,ABML
+4 KILL ABMSDT,ABMSCD,ABMDESC,ABMUNIT,ABMCHRG,ABMTCHRG
+5 KILL ABMLNCNT,ABMNOG,ABMPAGE,ABMMSG
+6 QUIT
+7 ;
GUARCHK ; set vars for header
+1 ;guarantor if there is one
+2 ;default to patient
+3 ;stays 0 if no guarantor entry found for DOS
SET ABMNOG=0
+4 IF +$ORDER(^AUPNGUAR(ABMP("PDFN"),1,0))'=0
Begin DoDot:1
+5 SET ABMSDTTO=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+6 SET ABMSDTFR=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,2)
+7 SET ABMGIEN=0
+8 FOR
SET ABMGIEN=$ORDER(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN))
IF +ABMGIEN=0
QUIT
Begin DoDot:2
+9 SET ABMGEFDA=0
+10 FOR
SET ABMGEFDA=$ORDER(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN,11,ABMGEFDA))
IF +ABMGEFDA=0
QUIT
Begin DoDot:3
+11 SET ABMGEFDT=$PIECE($GET(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN,11,ABMGEFDA,0)),U)
+12 SET ABMGENDT=$PIECE($GET(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN,11,ABMGEFDA,0)),U,2)
+13 IF ABMGEFDT>ABMSDTTO!(ABMGENDT>ABMSDTFR)
QUIT
+14 SET ABMNOG=1
+15 SET ABMG=$PIECE($GET(^AUPNGUAR(ABMP("PDFN"),1,ABMGIEN,0)),U)
+16 SET ABMGDA=$PIECE(ABMG,";")
SET ABMGFILE=$PIECE(ABMG,";",2)
+17 IF ABMGFILE["AUPNPAT"
Begin DoDot:4
+18 SET ABMGNAME=$EXTRACT($PIECE($GET(^DPT(ABMGDA,0)),U),1,50)
+19 SET ABMGSTR=$PIECE($GET(^DPT(ABMGDA,.11)),U)
+20 SET ABMGCITY=$PIECE($GET(^DPT(ABMGDA,.11)),U,4)
+21 SET ABMGST=$SELECT($PIECE($GET(^DPT(ABMGDA,.11)),U,5)'="":$PIECE($GET(^DIC(5,$PIECE($GET(^DPT(ABMGDA,.11)),U,5),0)),U,2),1:"")
+22 SET ABMGZIP=$PIECE($GET(^DPT(ABMGDA,.11)),U,6)
End DoDot:4
+23 IF ABMGFILE["AUTNINS"
Begin DoDot:4
+24 SET ABMGNAME=$PIECE($GET(^AUTNINS(ABMGDA,0)),U)
+25 SET ABMGSTR=$PIECE($GET(^AUTNINS(ABMGDA,0)),U,2)
+26 SET ABMGCITY=$PIECE($GET(^AUTNINS(ABMGDA,0)),U,3)
+27 SET ABMGST=$SELECT($PIECE($GET(^AUTNINS(ABMGDA,0)),U,4)'="":$PIECE($GET(^DIC(5,$PIECE($GET(^AUTNINS(ABMGDA,0)),U,4),0)),U,2),1:"")
+28 SET ABMGZIP=$PIECE($GET(^AUTNINS(ABMGDA,0)),U,5)
End DoDot:4
+29 IF ABMGFILE["AUTNEMPL"
Begin DoDot:4
+30 SET ABMGNAME=$EXTRACT($PIECE($GET(^AUTNEMPL(ABMGDA,0)),U),1,50)
+31 SET ABMGSTR=$PIECE($GET(^AUTNEMPL(ABMGDA,0)),U,2)
+32 SET ABMGCITY=$PIECE($GET(^AUTNEMPL(ABMGDA,0)),U,3)
+33 SET ABMGST=$SELECT($PIECE($GET(^AUTNEMPL(ABMGDA,0)),U,4)'="":$PIECE($GET(^DIC(5,$PIECE($GET(^AUTNEMPL(ABMGDA,0)),U,4),0)),U,2),1:"")
+34 SET ABMGZIP=$PIECE($GET(^AUTNEMPL(ABMGDA,0)),U,5)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;default to patient
+36 IF +$ORDER(^AUPNGUAR(ABMP("PDFN"),1,0))=0!(ABMNOG=0)
Begin DoDot:1
+37 SET ABMGNAME=$EXTRACT($PIECE($GET(^DPT(ABMP("PDFN"),0)),U),1,50)
+38 SET ABMGSTR=$PIECE($GET(^DPT(ABMP("PDFN"),.11)),U)
+39 SET ABMGCITY=$PIECE($GET(^DPT(ABMP("PDFN"),.11)),U,4)
+40 SET ABMGST=$SELECT($PIECE($GET(^DPT(ABMP("PDFN"),.11)),U,5)'="":$PIECE($GET(^DIC(5,$PIECE($GET(^DPT(ABMP("PDFN"),.11)),U,5),0)),U,2),1:"")
+41 SET ABMGZIP=$PIECE($GET(^DPT(ABMP("PDFN"),.11)),U,6)
End DoDot:1
+42 QUIT
COVRG ;EP
+1 KILL ABML
+2 KILL ABMBEN
+3 SET ABMIEN=0
SET ABMISNB=0
SET ABMBILLD=0
+4 FOR
SET ABMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:1
+5 SET (ABMINTRY,ABMCOV,ABMEFDT)=""
+6 SET ABMX=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMIEN,0))
+7 ;completed; don't print if doing batch
IF $PIECE(ABMX,U,3)="C"
SET ABMBILLD=1
+8 SET ABMINS=$PIECE(ABMX,U)
+9 ;I $P($G(^AUTNINS(ABMINS,2)),U)="N"!($P($G(^AUTNINS(ABMINS,0)),U)["NON-BEN") S ABMISNB=1 ;abm*2.6*10 HEAT73780
+10 ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMINS,".211","I"),1,"I")="N"!($PIECE($GET(^AUTNINS(ABMINS,0)),U)["NON-BEN")
SET ABMISNB=1
+11 SET ABMPRI=$PIECE(ABMX,U,2)
+12 IF ($PIECE($GET(^AUTNINS(ABMINS,0)),U)="BENEFICIARY PATIENT")
IF ($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)=ABMINS)
SET ABMABEN=1
+13 IF ($PIECE($GET(^AUTNINS(ABMINS,0)),U)="BENEFICIARY PATIENT")
SET ABMBEN=1
QUIT
+14 IF $PIECE($GET(^AUPNPAT(ABMP("PDFN"),11)),U,12)'="I"
SET ABMBEN=1
+15 ;Medicare
IF $PIECE(ABMX,U,4)'=""
Begin DoDot:2
+16 SET ABMINTRY=$GET(^AUPNMCR(ABMP("PDFN"),11,$PIECE(ABMX,U,4),0))
+17 SET ABMEFDT=$PIECE(ABMINTRY,U)
+18 SET ABMCOV=$PIECE(ABMINTRY,U,3)
End DoDot:2
+19 ;Railroad
IF $PIECE(ABMX,U,5)'=""
Begin DoDot:2
+20 SET ABMINTRY=$GET(^AUPNRRE(ABMP("PDFN"),11,$PIECE(ABMX,U,5),0))
+21 SET ABMEFDT=$PIECE(ABMINTRY,U)
+22 SET ABMCOV=$PIECE(ABMINTRY,U,3)
End DoDot:2
+23 ;Medicaid
IF $PIECE(ABMX,U,6)'=""
Begin DoDot:2
+24 SET ABMMULT=$PIECE(ABMX,U,7)
+25 IF ABMMULT=""
QUIT
+26 SET ABMINTRY=$GET(^AUPNMCD($PIECE(ABMX,U,6),11,ABMMULT,0))
+27 SET ABMEFDT=$PIECE(ABMINTRY,U)
+28 SET ABMCOV=$PIECE(ABMINTRY,U,3)
End DoDot:2
+29 ;PI
IF $PIECE(ABMX,U,8)'=""
Begin DoDot:2
+30 SET ABMINTRY=$GET(^AUPNPRVT(ABMP("PDFN"),11,$PIECE(ABMX,U,8),0))
+31 SET ABMEFDT=$PIECE(ABMINTRY,U,6)
+32 SET ABMPH=$PIECE(ABMINTRY,U,8)
+33 IF +ABMPH
SET ABMCOV=$PIECE($GET(^AUPN3PPH(ABMPH,0)),U,5)
End DoDot:2
+34 SET ABML(ABMPRI,ABMINS)=$GET(ABMCOV)_"^"_ABMEFDT
End DoDot:1
+35 QUIT
CENTER(X) ;EP
+1 SET CENTER=IOM/2
+2 WRITE ?CENTER-($LENGTH(X)/2),X
+3 QUIT
