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

ABMDF28W.m

Go to the documentation of this file. 
  1. ABMDF28W ; IHS/ASDST/DMJ - PRINT UB-04 ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**8,20**;NOV 12, 2009;Build 317
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p12 - IM24881 - Form alignment changes
  1.  ;
  1.  ;IHS/SD/SDR 2.6*20 - HEAT270943 - If the provider doesn't have a NPI it will print the facility NPI as the default.
  1.  ; *********************************************************************
  1.  ;
  1.  Q
  1.  ;
  1. WRT ; EP
  1.  ; Write data element in requested format
  1.  S ABMTAB=+$P(ABMDE,"^",2)+ABMP("LM")
  1.  I $P(ABMDE,"^",3)["R" S $P(ABMDE,"^")=$J($P(ABMDE,"^"),+$P(ABMDE,"^",3))
  1.  S ABMDE=$E($P(ABMDE,"^"),1,+$P(ABMDE,"^",3))
  1.  S:ABMTAB+$L(ABMDE)>IOM ABMDE=$E(ABMDE,1,IOM-ABMTAB)
  1.  W ?ABMTAB,ABMDE
  1.  Q
  1.  ;
  1. TEST ; EP
  1.  ; Test Alignment
  1.  S ABMP("LM")=$P(^ABMDEXP(28,0),"^",2)
  1.  N I
  1.  F I=1:1:4 D
  1.  .W !
  1.  .S ABMDE="XXXXX BLOCK 1 LINE "_I_" XXXXX"_"^^25"
  1.  .D WRT
  1.  .I I=2 D
  1.  ..S ABMDE="XXXXXXXXXXXXXXXXXXXXX"_"^53^20"
  1.  ..D WRT
  1.  ..S ABMDE="XXX"_"^77^4"
  1.  ..D WRT
  1.  ..Q
  1.  N I
  1.  F I=1:1:14 W !
  1.  S ABMDE="0100 ALL INCL ROOM & BOARD/ANC"_"^^29"
  1.  D WRT
  1.  S ABMDE="450.00 ^30^9R"
  1.  D WRT
  1.  S ABMDE=3_"^52^7R"
  1.  D WRT
  1.  S ABMDE=135000_" ^60^10R"
  1.  D WRT
  1.  W $$EN^ABMVDF("IOF")
  1.  Q
  1.  ;
  1. PROV ;EP - PROVIDER INFORMATION
  1.  ;  ABM("PRV",#) = UPIN/MCD #_Provider Name ^ UPIN/MCD# ^
  1.  ;                 Provider State License Number ^ NPI
  1.  S ABMPCNT=1                ; Initialize Provider Count
  1.  S ABMPRVTP="A"
  1.  S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
  1.  D GETPROV
  1.  S ABMPCNT=2
  1.  S ABMPRVTP="O"
  1.  S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0))
  1.  D GETPROV
  1.  F ABMPRVTP="R","T","F","S","P" D
  1.  .S ABMPRVNO=0             ; Initialize Provider number
  1.  .F  S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP,ABMPRVNO)) Q:'ABMPRVNO  D
  1.  ..Q:+$G(ABMPRVNO)=0
  1.  ..S ABMPCNT=ABMPCNT+1
  1.  ..Q:ABMPCNT>4             ; only 1st 4 providers
  1.  ..D GETPROV
  1.  Q
  1. GETPROV ;
  1.  ; NEW PERSON file IEN
  1.  Q:+$G(ABMPRVNO)=0
  1.  S ABMPRV=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRVNO,0)),U)
  1.  S ABM("PRV",ABMPCNT)=$P($G(^VA(200,ABMPRV,0)),U)  ;provider name
  1.  ;I $P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0 D  ;abm*2.6*20 IHS/SD/SDR HEAT270943
  1.  I (($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0)!($P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0)) D  ;abm*2.6*20 IHS/SD/SDR HEAT270943
  1.  .S $P(ABM("PRV",ABMPCNT),U,4)=$S(ABMPRVTP="F":"DN",ABMPRVTP="R":82,1:"ZZ")
  1.  .;S $P(ABM("PRV",ABMPCNT),U,4)=$P(ABM("PRV",ABMPCNT),U,4)_"#"_$P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)  ;abm*2.6*20 IHS/SD/SDR HEAT270943
  1.  .S $P(ABM("PRV",ABMPCNT),U,4)=$P(ABM("PRV",ABMPCNT),U,4)_"#"_$S($P($$NPI^XUSNPI("Individual_ID",ABMPRV),U)>0:$P($$NPI^XUSNPI("Individual_ID",ABMPRV),U),1:$P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U))  ;abm*2.6*20 IHS/SD/SDR HEAT270943
  1.  S $P(ABM("PRV",ABMPCNT),U,2)=""
  1.  ; If Medicare FI, find provider UPIN
  1.  I ABMP("ITYPE")="R" D
  1.  .S ABMUPIN=$P($G(^VA(200,ABMPRV,9999999)),"^",8)
  1.  .S:ABMUPIN="" ABMUPIN="PHS000"
  1.  .S $P(ABM("PRV",ABMPCNT),U,2)=ABMUPIN
  1.  ;If Medicaid FI, get MCD Number
  1.  I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
  1.  .S $P(ABM("PRV",ABMPCNT),U,2)=$P($G(^VA(200,ABMPRV,9999999.18,+ABMP("INS"),0)),U,2)
  1.  .S:$P(ABM("PRV",ABMPCNT),U,2)="" $P(ABM("PRV",ABMPCNT),U,2)=$P($G(^VA(200,ABMPRV,9999999)),U,7)
  1.  S ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",23)  ; state IEN
  1.  S:ABMVST="" ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",14)
  1.  S ABMP("RTYPE")=$S(ABMP("ITYPE")="R":"1G",ABMP("ITYPE")="D":"1D",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
  1.  D ABMPNUM(ABMP("RTYPE"),ABMPRV)
  1.  Q:$G(ABMR("REF",30))=""  ;abm*2.6*8 HEAT39389
  1.  I $P($G(^AUTNINS(ABMP("INS"),0)),U)="ARKANSAS MEDICAID" S ABMP("RTYPE")="0B"
  1.  I $P($G(^AUTNINS(ABMP("INS"),0)),U)="IOWA MEDICAID"!($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEBRASKA MEDICAID") S ABMP("RTYPE")="  "
  1.  S $P(ABM("PRV",ABMPCNT),U,3)=ABMP("RTYPE")_"#"_$S($P(ABM("PRV",ABMPCNT),U,2)'="":$P(ABM("PRV",ABMPCNT),U,2),1:$S(ABMR("REF",30)["-":$P(ABMR("REF",30),"-",2),1:ABMR("REF",30)))  ;Qualifier and Other Provider number
  1.  Q
  1. ABMPNUM(X,Y) ;
  1.  ;x=type
  1.  ;y=provider
  1.  S ABMEIC=X
  1.  S ABMIEN=Y
  1.  I ABMEIC="1C" D
  1.  .S ABMR("REF",30)=$$MCR^ABMEEPRV(ABMIEN)
  1.  .Q:$$RCID^ABMUTLP(ABMP("INS"))'="C00900"
  1.  .Q:$$RCID^ABMUTLP(ABMP("INS"))'="04402"
  1.  .S ABMR("REF",30)=$$NPI^ABMEEPRV(ABMIEN,ABMP("LDFN"),ABMP("INS"))
  1.  I ABMEIC="1D" D
  1.  .S ABMR("REF",30)=$$MCD^ABMEEPRV(ABMIEN,+$G(ABMPAYER))
  1.  I ABMEIC="0B" D
  1.  .S ABMR("REF",30)=$$SLN^ABMEEPRV(ABMIEN)
  1.  I ABMEIC="1G" D
  1.  .S ABMR("REF",30)=$$UPIN^ABMEEPRV(ABMIEN)
  1.  I "^BQ^G2^1A^1B^B3^1H^1J^EI^FH^G5^LU^SY^U3^X5^"[("^"_ABMEIC_"^") D
  1.  .S ABMR("REF",30)=$$PI^ABMUTLF(ABMP("LDFN"))
  1.  Q