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

ABMDF51Y.m

Go to the documentation of this file. 
  1. ABMDF51Y ;IHS/DSD/DMJ/LSL - PRINT UB92      ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
  1.  ;Original;DMJ; IHS/CAO/JLB 2/6/2000  added to CAO changes 
  1.  ;
  1.  ;IHS/DSD/LSL -3/23/98 - Add to line tag 18 to quit print if itemized for flat rate billing on a UB-92.
  1.  ;IHS/SD/SDR - v2.5 p9 - IM15936 - Correct print format issues
  1.  ;IHS/SD/SDR - v2.5 p10 - IM20395 - Split out lines being bundled by rev code
  1.  ;IHS/SD/SDR - v2.5 p11 - IM24315 - Line items weren't printing box 50 s/b O/P MEDI-CAL if AO CONTROL NUMBER is 61044
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check from 'equals' to 'contains'
  1. 13 ;
  1.  W !
  1.  K ABMR
  1.  S ABM("9SP")="         "
  1.  N I
  1.  F I=160:10:200 D
  1.  .D @(I_"^ABMER41A")
  1.  N I
  1.  F I=210:10:390 D
  1.  .D @(I_"^ABMER41")
  1.  ; Policy holder street address
  1.  S ABMDE=$G(ABM(9000003.1,+$G(ABME("PH")),.09,"E"))_"^^40"
  1.  D WRT^ABMDF11W                     ; form locator #38
  1.  I ABMR(41,160) D
  1.  .S ABMDE=ABMR(41,160)_"^43^2"     ; Value code 1
  1.  .D WRT^ABMDF11W                   ; form locator #39a
  1.  I ABMR(41,170) D
  1.  .S ABMDE=+ABMR(41,170)_"^46^9R"   ; Value Amount 1
  1.  .D WRT^ABMDF11W                   ; form locator #39a
  1.  I ABMR(41,180)  D
  1.  .S ABMDE=ABMR(41,180)_"^56^2"     ; Value code 2
  1.  .D WRT^ABMDF11W                   ; form locator #40a
  1.  I ABMR(41,190) D
  1.  .S ABMDE=+ABMR(41,190)_"^59^9R"   ; Value amount 2
  1.  .D WRT^ABMDF11W                   ; form locator #40a
  1.  I ABMR(41,200) D
  1.  .S ABMDE=ABMR(41,200)_"^69^2"     ; Value code 3
  1.  .D WRT^ABMDF11W                   ; form locator #41a
  1.  I ABMR(41,210) D
  1.  .S ABMDE=+ABMR(41,210)_"^72^9R"   ; Value amount 3
  1.  .D WRT^ABMDF11W                   ; form locator #41a
  1.  ;
  1. 14 ;
  1.  W !
  1.  S ABMDE=$G(ABM(9000003.1,+$G(ABME("PH")),.11,"E"))  ; Policy holders Address - City
  1.  I $G(ABM(9000003.1,+$G(ABME("PH")),.12,"I")) D
  1.  .S ABMPHST=$P(^DIC(5,ABM(9000003.1,ABME("PH"),.12,"I"),0),"^",2)  ; Policy holders Address - State
  1.  .S ABMDE=ABMDE_", "_ABMPHST
  1.  .Q
  1.  S ABMDE=ABMDE_"  "_$G(ABM(9000003.1,+$G(ABME("PH")),.13,"E"))  ; add Policy holders zip
  1.  I ABMDE'="" D
  1.  .S ABMDE=ABMDE_"^^40"             ; Policy holders address
  1.  .D WRT^ABMDF11W                   ; form locator #38
  1.  I ABMR(41,220) D
  1.  .S ABMDE=ABMR(41,220)_"^43^2"     ; Value code 4
  1.  .D WRT^ABMDF11W                   ; form locator #39b
  1.  I ABMR(41,230) D
  1.  .S ABMDE=+ABMR(41,230)_"^46^9R"   ; Value amount 4
  1.  .D WRT^ABMDF11W                   ; form locator #39b
  1.  I ABMR(41,240) D
  1.  .S ABMDE=ABMR(41,240)_"^56^2"     ; Value code 5
  1.  .D WRT^ABMDF11W                   ; form locator #40b
  1.  I ABMR(41,250) D
  1.  .S ABMDE=+ABMR(41,250)_"^59^9R"   ; Value amount 5
  1.  .D WRT^ABMDF11W                   ; form locator #40b
  1.  I ABMR(41,260) D
  1.  .S ABMDE=ABMR(41,260)_"^69^2"     ; Value code 6
  1.  .D WRT^ABMDF11W                   ; form locator #41b
  1.  I ABMR(41,270) D
  1.  .S ABMDE=+ABMR(41,270)_"^72^9R"   ; Value amount 6
  1.  .D WRT^ABMDF11W                   ; form locator #41b
  1.  ;
  1. 15 ;
  1.  W !
  1.  K ABM
  1.  I ABMR(41,280) D
  1.  .S ABMDE=ABMR(41,280)_"^43^2"     ; Value code 7
  1.  .D WRT^ABMDF11W                   ; form locator #39c
  1.  I ABMR(41,290) D
  1.  .S ABMDE=+ABMR(41,290)_"^46^9R"   ; Value amount 7
  1.  .D WRT^ABMDF11W                   ; form locator #39c
  1.  I ABMR(41,300) D
  1.  .S ABMDE=ABMR(41,300)_"^56^2"     ; Value code 8
  1.  .D WRT^ABMDF11W                   ; form locator #40c
  1.  I ABMR(41,310) D
  1.  .S ABMDE=+ABMR(41,310)_"^59^9R"   ; Value amount 8
  1.  .D WRT^ABMDF11W                   ; form locator #40c
  1.  I ABMR(41,320) D
  1.  .S ABMDE=ABMR(41,320)_"^69^2"     ; Value code 9
  1.  .D WRT^ABMDF11W                   ; form locator #41c
  1.  I ABMR(41,330) D
  1.  .S ABMDE=+ABMR(41,330)_"^72^9R"   ; Value amount 9
  1.  .D WRT^ABMDF11W                   ; form locator #41c
  1.  ;
  1. 16 ;
  1.  W !
  1.  I ABMR(41,340) D
  1.  .S ABMDE=ABMR(41,340)_"^43^2"     ; Value code 10
  1.  .D WRT^ABMDF11W                   ; form locator #39d
  1.  I ABMR(41,350) D
  1.  .S ABMDE=+ABMR(41,350)_"^46^9R"   ; Value amount 10
  1.  .D WRT^ABMDF11W                   ; form locator #39d
  1.  I ABMR(41,360) D
  1.  .S ABMDE=ABMR(41,360)_"^56^2"     ; Value code 11
  1.  .D WRT^ABMDF11W                   ; form locator #40d
  1.  I ABMR(41,370) D
  1.  .S ABMDE=+ABMR(41,370)_"^59^9R"   ; Value amount 11
  1.  .D WRT^ABMDF11W                   ; form locator #40d
  1.  I ABMR(41,380) D
  1.  .S ABMDE=ABMR(41,380)_"^69^2"     ; Value code 12
  1.  .D WRT^ABMDF11W                   ; form locator #41d
  1.  I ABMR(41,390) D
  1.  .S ABMDE=+ABMR(41,390)_"^72^9R"   ; Value amount 12
  1.  .D WRT^ABMDF11W                   ; form locator #41d
  1.  ;
  1. 18 ;
  1.  ; Lines 18 - 40 on form (description area)
  1.  ; ABMVR(IEN,code,counter) = IEN ^ Code ^ Modifier ^ 2nd Modifier ^ 
  1.  ;                   Total units ^ Total charges ^ ^ Unit charge ^
  1.  ;                   NDC name or description ^ date/time
  1.  W !
  1.  K ABMRV
  1.  D ORV^ABMERGRV                     ; get other revenue codes
  1.  D P1^ABMERGRV                      ; Build ABMVR of revenue codes
  1.  ; Itemized UB-92 flag (1=yes, 0=no)
  1.  S ABMITMZ=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,12)
  1.  N I,J,L
  1.  S I=0
  1.  S (ABMCTR,ABMRV("ZZTOT"),ABMRV("NCTOT"))=0
  1.  F  S I=$O(ABMRV(I)) Q:'I  D
  1.  .S J=-1
  1.  .F  S J=$O(ABMRV(I,J)) Q:J=""  D
  1.  ..S L=0
  1.  ..F  S L=$O(ABMRV(I,J,L)) Q:+L=0  D
  1.  ...; Grand total charges
  1.  ...S:J'="ZZTOT" ABMRV("ZZTOT")=ABMRV("ZZTOT")+$P(ABMRV(I,J,L),U,6)
  1.  ...; Grand total noncovered charges
  1.  ...S:J'="ZZTOT" ABMRV("NCTOT")=ABMRV("NCTOT")+$P(ABMRV(I,J,L),U,7)
  1.  ...; if not itemized bill and not done, accumulate totals
  1.  ...I 'ABMITMZ,J'="ZZTOT" D
  1.  ....S $P(ABMRV(I,"ZZTOT",1),U)=I   ; IEN to REVENUE CODE
  1.  ....S:$D(ABMP("CPT")) $P(ABMRV(I,"ZZTOT",1),U,2)=ABMP("CPT")
  1.  ....N K
  1.  ....; Accumulate totals per revenue code
  1.  ....F K=5:1:7 S $P(ABMRV(I,"ZZTOT",1),U,K)=$P(ABMRV(I,"ZZTOT",1),U,K)+$P(ABMRV(I,J,L),U,K)
  1.  ....S $P(ABMRV(I,"ZZTOT",1),U,8)=$P(ABMRV(I,J,L),U,8)  ; unit charge
  1.  ....Q
  1.  ...I 'ABMITMZ,J'="ZZTOT" Q
  1.  ...I ABMITMZ,J="ZZTOT" Q    ; If itemized and done, Q
  1.  ...W !
  1.  ...S ABMCTR=ABMCTR+1              ; Count items
  1.  ...; If more than 22 items, complete bottom of form,
  1.  ...; then start a new page
  1.  ...I ABMCTR>22 D
  1.  ....S ABMORE=1
  1.  ....N I,J
  1.  ....D 42
  1.  ....D ^ABMDF51Z
  1.  ....W $$EN^ABMVDF("IOF")
  1.  ....N I,J
  1.  ....D 1^ABMDF51X
  1.  ....K ABMORE
  1.  ....N I
  1.  ....F I=1:1:12 W !
  1.  ....S ABMCTR=1
  1.  ....Q
  1.  ...; If description is blank, get it from visit type in INSURER file
  1.  ...I $P(ABMRV(I,J,L),U,9)="" D
  1.  ....S ABMDE=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,9)
  1.  ....S:ABMDE="" ABMDE=$P($G(^AUTTREVN(I,0)),U,2)  ; standard abbreviation
  1.  ....S ABMDE=ABMDE_"^5^24"        ; Description
  1.  ....D WRT^ABMDF11W               ; form locator #43
  1.  ....Q
  1.  ...; If description, use it
  1.  ...I $P(ABMRV(I,J,L),U,9)'="" D
  1.  ....S ABMDE=$P(ABMRV(I,J,L),U,9)_"^5^24"  ; Description
  1.  ....D WRT^ABMDF11W               ; form locator #43
  1.  ....Q
  1.  ...; HCPCS/rates -- form locator #44
  1.  ...S ABMDE=$S($L($P(ABMRV(I,J,L),U,2))>3:$P(ABMRV(I,J,L),U,2)_$S($P(ABMRV(I,J,L),U,3)]"":"-"_$P(ABMRV(I,J,L),U,3),1:"")_"^30^9",$P(ABMRV(I,J,L),U,8):$J($P(ABMRV(I,J,L),U,8),1,2)_"^30^9R",1:"")
  1.  ...D WRT^ABMDF11W
  1.  ...S ABMDE=$$MDY^ABMDUTL(ABMP("VDT"))_"^40^6"
  1.  ...D WRT^ABMDF11W                 ;form locator #45
  1.  ...S ABMDE=$P(ABMRV(I,J,L),U,5)_"^47^7R"  ; Total units per item
  1.  ...D WRT^ABMDF11W                 ; form locator #46
  1.  ...S ABMDE=$FN($P(ABMRV(I,J,L),U,6),"T",2)
  1.  ...S ABMDE=$TR(ABMDE,".")_"^55^10R"   ; Total charges per item
  1.  ...D WRT^ABMDF11W                 ; form locator #47
  1.  ...S ABMDE=$FN($P(ABMRV(I,J,L),U,7),"T",2)
  1.  ...I +ABMDE D
  1.  ....S ABMDE=$TR(ABMDE,".")_"^66^10R"  ; Total noncover charges per item
  1.  ....D WRT^ABMDF11W               ; form locator #48
  1.  ....Q
  1.  F  W ! Q:$Y>39
  1.  S ABMDE="0001 TOTAL^^10"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=$TR($FN(ABMRV("ZZTOT"),"T",2),".")_"^55^10R"  ; Grand total
  1.  D WRT^ABMDF11W                     ; last item in description section
  1.  I +ABMRV("NCTOT") D
  1.  .S ABMDE=$TR($FN(ABMRV("NCTOT"),"T",2),".")_"^66^10R"
  1.  .D WRT^ABMDF11W                   ; Grand total - noncovered items
  1.  .Q
  1.  N I
  1.  K ABMRV
  1.  ;
  1. 42 ;
  1.  ; Lines 42 - 44
  1.  W !
  1.  K ABMP("SET")
  1.  D ^ABMER30                         ; get insurer and payment data
  1.  N I
  1.  F I=1:1:3 D
  1.  .Q:'$D(ABMREC(30,I))
  1.  .W ! S ABMFLAG=I
  1.  .; Insurer name_" "_Payor Sub Identification
  1.  .;I $E(ABMREC(30,I),26,30)=61044 S ABMDE="O/P MEDI-CAL^^25"  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  .I $E(ABMREC(30,I),26,30)["61044" S ABMDE="O/P MEDI-CAL^^25"  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  .E  S ABMDE=$E(ABMREC(30,I),54,78)_" "_$E(ABMREC(30,I),31,34)_"^^25"
  1.  .D WRT^ABMDF11W                                 ; form locator #50
  1.  .S ABMDE=$E(ABMREC(30,I),160,172)_"^26^13"  ; Provider ID (blank)
  1.  .D WRT^ABMDF11W                             ; form locator #51
  1.  .S ABMDE=$E(ABMREC(30,I),142)_"^40^1"       ; Release code
  1.  .D WRT^ABMDF11W                             ; form locator #52
  1.  .S ABMDE=$E(ABMREC(30,I),143)_"^43^1"       ; Ben Assgn Indicator
  1.  .D WRT^ABMDF11W                             ; form locator #53
  1.  .S ABMDE=+$E(ABMREC(30,I),173,182)_" ^45^10R"  ; 3PB pymnt recieve
  1.  .I +ABMDE D WRT^ABMDF11W                    ; form locator #54
  1.  .S ABMDE=+$E(ABMREC(30,I),183,192)_" ^56^10R"  ; Est 3PB amt due
  1.  .I +ABMDE D WRT^ABMDF11W                    ; form locator #55
  1.  W:'$G(ABMFLAG) !
  1.  W !!
  1.  K ABMR,ABMQUIT
  1.  Q