Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMPTSMT

ABMPTSMT.m

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