ABMDF28Y ; IHS/SD/SDR - PRINT UB-04 ;
;;2.6;IHS Third Party Billing;**1,2,4,6,9,10,11,13,19,20,21,22,23,25,27**;NOV 12, 2009;Build 486
;IHS/SD/SDR-2.6*20-HEAT262141-AHCCCS RX. Print detail lines for all meds, but won't print price, only NDC, desc, date, and units.
;IHS/SD/SDR-2.6*21-HEAT205579-Made T1015 print first for ARBOR HEALTH PLAN
;IHS/SD/SDR-2.6*21-HEAT268438-check for 61044 from 61004 for Medi-Cal
;IHS/SD/SDR-2.6*21-HEAT240744-call to resort,print lines for Medi-Cal dialysis billing
;IHS/SD/SDR 2.6*22 HEAT335246 chk new parm for printing itemized w/first line printing flat rate and NDC.
;IHS/SD/SDR 2.6*23 HEAT347035 Changed how it was getting rev code; made rev code print when Medi-Cal and there is chg on line item.
; Made change to ABMDF28S to ake T1015 print on the top line for Medi-Cal; it caused issue with ABMRV("ZZTOT" and ABMRV("NCTOT") so had to add $G to stop UNDEF
;IHS/SD/SDR 2.6*25 CR10016 correction to AZ Mcd 997 to make 0.00 print on all lines except first; first line prints flat rate;
; Also made change to have rev code print on every line even if chg is 0.00
;IHS/SD/AML,SDR 2.6*27 CR8897 Split to routine ABMDF28Q due to size. Made rev code print for AZ Mcd 997 claims
13 ; EP
W !
K ABMR
S ABM("9SP")=" "
N I
F I=160:10:200 D
.D @(I_"^ABMER41A")
N I
F I=210:10:390 D
.D @(I_"^ABMER41")
;Policy holder st addr
D 38^ABMDF28V ;split abm*2.6*21
D VALCDS1^ABMDF28V ;split abm*2.6*21
14 ;
W !
D 38P2^ABMDF28V ;split abm*2.6*21
D VALCDS2^ABMDF28V ;split abm*2.6*21
Q:$G(ABMORE)
15 ;
W !
K ABM
D VALCDS3^ABMDF28V ;split abm*2.6*21
16 ;
W !
D VALCDS4^ABMDF28V ;split abm*2.6*21
18 ;
;Lines 18-40 on form (desc area)
;ABMRV(IEN,code,cntr)=IEN^Code^Mod^2nd Mod^Total unts^Total chgs^^Unit chg^NDC name/desc^dt/tm
W !
K ABMRV
D ORV^ABMERGRV ;get other rev codes
D P1^ABMERGRV ;Build ABMVR of rev codes
;Itemized UB-92 flag (1=yes, 0=no)
S ABMITMZ=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)
S ABMPOS=0 ;abm*2.6*27 IHS/SD/SDR CR8897
I "^51^52^53^54^55^"[("^"_$$GET1^DIQ(9002274.03,$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,6),".01","E")_"^") S ABMPOS=1 ;Place of Service setup for facility ;abm*2.6*27 IHS/SD/SDR CR8897
I (((ABMITMZ)&($P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&($D(ABMP("FLAT")))!($$RCID^ABMUTLP(ABMP("INS")))["61044")) D START^ABMERGR4 K ABMP("FLAT") ;abm*2.6*22 HEAT335246
I (($G(ABMP("VTYP"))=721)!($P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)["DIALYSIS")) S ABMDIAL=1 ;abm*2.6*21 HEAT240744
I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")) D COMPILE^ABMDF28S ;dialysis ;abm*2.6*21 HEAT240744
;
;start new abm*2.6*27 IHS/SD/SDR CR8897
K I,J,L
S I=0
F S I=$O(ABMRV(I)) Q:'I D
.S J=-1
.F S J=$O(ABMRV(I,J)) Q:J="" D
..S L=0
..F S L=$O(ABMRV(I,J,L)) Q:+L=0 D
...Q:$P($G(ABMRV(I,J,L)),U,2)=""
...S ABMX("CPT",$P(ABMRV(I,J,L),U,2))=+$G(ABMX("CPT",$P(ABMRV(I,J,L),U,2)))+1
S ABMX("CPT","FLG")=0
S I=""
;F S I=$O(ABMX("CPT",I)) Q:I="" D
;.I $G(ABMX("CPT",I))>1 S ABMX("CPT","FLG")=1
;I (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(+$G(ABMX("CPT","FLG"))=1) D ;if Medi-Cal and the same CPT multiple times
I ($$RCID^ABMUTLP(ABMP("INS"))["61044") D ;if Medi-Cal
.I ((ABMP("VTYP")=142))&((ABMP("BTYP")=731)) D 23CMPL^ABMDF28S Q
.I ((ABMPOS=1)&(ABMP("VTYP")=142)) D 23CMPL^ABMDF28S Q
.I (($G(ABMDIAL)'=1)&(ABMP("VTYP")'=142)&(ABMP("BTYP")'=731)) D 23CMPL^ABMDF28S Q
.I ((ABMPOS=1)&(ABMP("BTYP")=731)&(ABMP("VTYP")'=142)) D 23CMPL^ABMDF28S
;end new abm*2.6*27 IHS/SD/SDR CR8897
;
K I,J,L
I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,26)="Y" D 2LNMDS^ABMDF28S ;put meds on 2 lines ;abm*2.6*21 split rtn
S I=0
D PGCNT^ABMDF28S ;split rtn abm*2.6*21
;start new abm*2.6*13 HEAT117086
S (ABMCTR,ABMRV("ZZTOT"),ABMRV("NCTOT"))=0
D T1015^ABMDF28S ;abm*2.6*21 HEAT205579
;
I ABMP("ITYPE")="D" D ^ABMDF28Q ;abm*2.6*27 IHS/SD/SDR CR8897 split routine
;
D ^ABMDF28P ;abm*2.6*27 IHS/SD/SDR CR8897 split routine
K I,J,L
S I=0
S ABMPGCNT=1
F S I=$O(ABMRV(I)) Q:'I D
.S J=-1
.F S J=$O(ABMRV(I,J)) Q:J="" D
..S L=0
..F S L=$O(ABMRV(I,J,L)) Q:+L=0 D
...I 'ABMITMZ,J'="ZZTOT" Q
...I ABMITMZ,J="ZZTOT" Q ;If itemized & done, Q
...W !
...S ABMCTR=ABMCTR+1 ;Cnt items
...;If >22 items, complete bottom of form, start new page
...I ABMCTR>22 D
....S ABMORE=1
....S ABMDE=ABMPGCNT_" "_ABMPGTOT_"^11^15" ;page#
....D WRT^ABMDF28W ;#43
....S ABMDE=$$MDY^ABMDUTL($S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),$P(^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))_"^45^20" ;create dt
....D WRT^ABMDF28W
....W !
....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 ABMDE=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"") ;NPI-#56
....I DUZ(2)=4610,($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")="EDS/CDP") S ABMDE=1124150891
....S ABMDE=ABMDE_"^68^15"
....D WRT^ABMDF28W
....S ABMPGCNT=ABMPGCNT+1
....N I,J
....D 42
....D ^ABMDF28Z
....W $$EN^ABMVDF("IOF")
....N I,J
....D 1^ABMDF28X
....K ABMORE
....N I
....F I=1:1:4 W !
....S ABMCTR=1
....Q
...;S ABMDE=$$GETREV^ABMDUTL(I)_"^^4R" ;Rev code ;abm*2.6*23 HEAT347035
...S ABMDE=$S(($P(ABMRV(I,J,L),U)'=0):$$GETREV^ABMDUTL($P(ABMRV(I,J,L),U)),1:"")_"^^4R" ;Rev code ;abm*2.6*23 HEAT347035
...I L["." S ABMDE="" ;abm*2.6*9 HEAT18507
...;I $$RCID^ABMERUTL(ABMP("INS"))'=61004!((ABMP("VDT")>3100630)&($P($G(^AUTNINS(ABMP("INS"),0)),U)="EAPC")) D WRT^ABMDF28W ;#42 ;abm*2.6*21 HEAT268438
...;I $$RCID^ABMERUTL(ABMP("INS"))'["61044"!((ABMP("VDT")>3100630)&($P($G(^AUTNINS(ABMP("INS"),0)),U)="EAPC")) D WRT^ABMDF28W ;#42 ;abm*2.6*21 HEAT268438 ;abm*2.6*23 HEAT347035
...;I '(($$RCID^ABMERUTL(ABMP("INS"))["61044")&($D(ABMP("FLAT"))))&(+$P(ABMRV(I,J,L),U,6)'=0) D WRT^ABMDF28W ;abm*2.6*23 IHS/SD/SDR HEAT347035 ;abm*2.6*27 IHS/SD/SDR CR8897
...I (($$RCID^ABMERUTL(ABMP("INS"))=99999)&(ABMP("VTYP")=997)&(+$P(ABMRV(I,J,L),U,6)=0)) D WRT^ABMDF28W ;abm*2.6*25 IHS/SD/SDR CR10016
...I ((ABMP("VDT")>3100630)&($P($G(^AUTNINS(ABMP("INS"),0)),U)="EAPC")) D WRT^ABMDF28W ;#42 ;abm*2.6*21 HEAT268438 ;abm*2.6*23 HEAT347035
...;start new abm*2.6*27 IHS/SD/SDR CR8897
...I (($$RCID^ABMUTLP(ABMP("INS")))["61044") D
....I +$P(ABMRV(I,J,L),U)=0 Q ;don't do this part if no rev code
....I ((ABMPOS=1)&((ABMP("BTYP")=731)!(ABMP("VTYP")'=142))) S ABMDE=$$GETREV^ABMDUTL($P(ABMRV(I,J,L),U))_"^^4"
....I '($D(ABMP("FLAT"))&(+$P(ABMRV(I,J,L),U,6)'=0)) S ABMDE=$$GETREV^ABMDUTL($P(ABMRV(I,J,L),U))_"^^4"
....I +$G(ABMDIAL)=1 S ABMDE="^^4"
....D WRT^ABMDF28W
...I ($$RCID^ABMUTLP(ABMP("INS"))'["61044") D WRT^ABMDF28W
...;end new abm*2.6*27 IHS/SD/SDR CR8897
...;If desc is blank, get it from vtyp in INS file
...I $P(ABMRV(I,J,L),U,9)="" D
....Q:+$P(ABMRV(I,J,L),U)=0 ;quit if no rev code ;abm*2.6*23 HEAT347035
....S ABMDE=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,9)
....;S:ABMDE="" ABMDE=$P($G(^AUTTREVN(I,0)),U,2) ;std abbrev ;abm*2.6*23 HEAT347035
....S:ABMDE="" ABMDE=$P($G(^AUTTREVN($P(ABMRV(I,J,L),U),0)),U,2) ;std abbrev ;abm*2.6*23 HEAT347035
....S ABMDE=ABMDE_"^5^24" ;Desc
....;I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&(J="Z6004")) S ABMDE="MAINTENANCE DIALYSIS WITH^5^25" ;abm*2.6*21 HEAT240744 ;broke between 21 and 26 so required a change ;abm*2.6*27 IHS/SD/SDR CR8897
....I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&($P(ABMRV(I,J,L),U,2)="Z6004")) S ABMDE="MAINTENANCE DIALYSIS WITH^5^25" ;abm*2.6*21 HEAT240744 ;broke between 21 and 26 so required a change; abm*2.6*27 IHS/SD/SDR CR8897
....I (($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$P(ABMRV(I,J,L),U,6)=0)) S ABMDE="^^5^24" ;don't print desc for Medi-Cal when charge amt is 0 ;abm*2.6*23 HEAT347035
....D WRT^ABMDF28W ;#43
....Q
...I $P(ABMRV(I,J,L),U,9)'="" D ;if desc, use it
....S ABMDE=$P(ABMRV(I,J,L),U,9)_"^5^24" ;Desc
....I (($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$P(ABMRV(I,J,L),U,6)=0)) S ABMDE="^^5^24" ;don't print desc for Medi-Cal when charge amt is 0 ;abm*2.6*23 HEAT347035
....D WRT^ABMDF28W ;#43
....Q
...;start new abm*2.6*27 IHS/SD/SDR CR8897 - note moved this up from further down to make info print on first line not last line
...S ABMCAFLG=0
...I ($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$G(ABMITMZ)) D I ABMCAFLG=1 Q
....I ((ABMPOS=1)&(ABMP("BTYP")=731)&(ABMP("VTYP")'=142)) S ABMCAFLG=1 D CALYRTC^ABMDF28S
....I ((ABMP("BTYP")=731)&(ABMP("VTYP")=142)) S ABMCAFLG=1 D 23PRT^ABMDF28S
...;end new abm*2.6*27 IHS/SD/SDR CR8897
...;HCPCS/rates-#44
...S ABMMODL=$S($P(ABMRV(I,J,L),U,3)]"":$P(ABMRV(I,J,L),U,3),1:"")
...S ABMMODL=ABMMODL_$S($P(ABMRV(I,J,L),U,4)]"":$P(ABMRV(I,J,L),U,4),1:"")
...S ABMMODL=ABMMODL_$S($P(ABMRV(I,J,L),U,12)]"":$P(ABMRV(I,J,L),U,12),1:"")
...S ABMDE=$S($L($P(ABMRV(I,J,L),U,2))>3:$P(ABMRV(I,J,L),U,2)_ABMMODL_"^30^14",$P(ABMRV(I,J,L),U,8)&(+$P(ABMRV(I,J,L),U,2)'=0):$J($P(ABMRV(I,J,L),U,8),1,2)_"^30^14R",+ABMMODL:$J(ABMMODL,1,2)_"^30^14",1:"")
...;make 2-digit CPT print for Medi-Cal
...I $$RCID^ABMUTLP(ABMP("INS"))["61044" D ;abm*2.6*23 HEAT347035
....S ABMDE=$S($P(ABMRV(I,J,L),U,2)'="":$P(ABMRV(I,J,L),U,2)_ABMMODL_"^30^14",$P(ABMRV(I,J,L),U,8)&(+$P(ABMRV(I,J,L),U,2)'=0):$J($P(ABMRV(I,J,L),U,8),1,2)_"^30^14R",+ABMMODL:$J(ABMMODL,1,2)_"^30^14",1:"") ;abm*2.6*23 HEAT347035
...I $P($G(ABMRV(I,J,L)),U,14)'="",($P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,24)="Y") S ABMDE="RX"_$P(ABMRV(I,J,L),U,14)_"^30^9"
...I ABMDE=""&($D(ABMP("FLAT"))!((I>99)&(I<250))) S ABMDE=$J($S($D(ABMP("FLAT")):$P(ABMP("FLAT"),U),1:$P(ABMRV(I,J,L),U,8)),1,2)_"^30^14" ;deflt flat rate
...I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,20)="Y" S ABMDE="^30^14"
...;I $$RCID^ABMERUTL(ABMP("INS"))=99999&(ABMP("VTYP")=997) S ABMDE=$S(ABMCTR=1:$J($P(ABMP("FLAT"),U),1,2),1:"")_"^30^14" ;abm*2.6*20 HEAT262141 ;abm*2.6*25 IHS/SD/SDR CR10016
...I $$RCID^ABMERUTL(ABMP("INS"))=99999&(ABMP("VTYP")=997) S ABMDE=$S(ABMCTR=1:$J($P(ABMP("FLAT"),U),1,2),1:$J(0,1,2))_"^30^14R" ;abm*2.6*20 HEAT262141 ;abm*2.6*25 IHS/SD/SDR CR10016
...;I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&(J="Z6004")) S ABMDE="^30^14" ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/SDR CR8897
...I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&($P(ABMRV(I,J,L),U,2)="Z6004")) S ABMDE="^30^14" ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/SDR CR8897
...I (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(ABMP("BTYP")=731)&(ABMITMZ)&(+$G(ABMCPTM)=0) S ABMDE="^30^14" ;abm*2.6*27 IHS/SD/AML CR8897
...D WRT^ABMDF28W
...S ABMDE=$$MDY^ABMDUTL($P(ABMRV(I,J,L),U,10))_"^45^6" ;DOS
...I (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(ABMP("BTYP")=731) S ABMDE=$$MDY^ABMDUTL($S($P(ABMRV(I,J,L),U,27):$P(ABMRV(I,J,L),U,27),1:$P(ABMRV(I,J,L),U,10)))_"^45^6" ;DOS ;abm*2.6*27 IHS/SD/SDR CR8897
...D WRT^ABMDF28W ;#45
...S ABMDE=$P(ABMRV(I,J,L),U,5)_"^52^7R" ;Tot units/item
...;I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&(J="Z6004")) S ABMDE="^52^7R" ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/SDR CR8897
...;start new abm*2.6*27 IHS/SD/SDR CR8897
...I ($$RCID^ABMUTLP(ABMP("INS"))["61044") D
....I ((+$G(ABMDIAL)=1)&($P(ABMRV(I,J,L),U,2)="Z6004")) S ABMDE="^52^7R"
....I ((ABMP("BTYP")=731)&(ABMITMZ)&(+$G(ABMCPTM)=0)) S ABMDE="^52^7R"
....I (($P(ABMRV(I,J,L),U,5)=0)&($P(ABMRV(I,J,L),U,6)=0)) S ABMDE="00^52^7R" ;if Medi-Cal, no charge, and no units make units print 00
...;end new abm*2.6*27 IHS/SD/SDR CR8897
...D WRT^ABMDF28W ;#46
...S ABMDE=$FN($P(ABMRV(I,J,L),U,6),"T",2)
...S ABMDE=$TR(ABMDE,".")_"^61^9R" ;Tot chg per item
...I L["." S ABMDE="" ;abm*2.6*9 HEAT18507
...I $$RCID^ABMERUTL(ABMP("INS"))=99999&(ABMP("VTYP")=997) S ABMDE="^61^9R"
...;I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&(J="Z6004")) S ABMDE="^61^9R" ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/SDR CR8897
...;start new abm*2.6*27 IHS/SD/SDR CR8897
...I ($$RCID^ABMUTLP(ABMP("INS"))["61044") D
....I ((+$G(ABMDIAL)=1)&($P(ABMRV(I,J,L),U,2)="Z6004")) S ABMDE="^61^9R" ;abm*2.6*21 HEAT240744
....I ((ABMP("BTYP")=731)&(ABMITMZ)&(+$G(ABMCPTM)=0)) S ABMDE="^61^9R"
...;end new abm*2.6*27 IHS/SD/SDR CR8897
...D WRT^ABMDF28W ;#47
...S ABMDE=$FN($P(ABMRV(I,J,L),U,7),"T",2)
...I +ABMDE D
....S ABMDE=$TR(ABMDE,".")_"^71^9R" ;Tot noncover chgs/item
....D WRT^ABMDF28W ;#48
....Q
...;I $G(ABMRV(I,J,L,1))'="" D Z6004PRT^ABMDF28S ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/AML CR8897
...;start new abm*2.6*27 IHS/SD/SDR CR8897
...I ($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$G(ABMITMZ)) D
....I (($P(ABMRV(I,J,L),U,2)="Z6004")&($G(ABMRV(I,J,L,1))'="")&(ABMP("VTYP")'=142)) D Z6004PRT^ABMDF28S
....;I (ABMP("BTYP")=731)&(ABMP("VTYP")'=142) D CALYRTC^ABMDF28S
....;I (ABMP("BTYP")=731)&(ABMP("VTYP")=142) D 23PRT^ABMDF28S
;end new abm*2.6*27 IHS/SD/SDR CR8897
D 18A^ABMDF28R ;abm*2.6*23 split rtn
;
42 ;
D 42^ABMDF28R ;abm*2.6*23 split rtn
Q
ABMDF28Y ; IHS/SD/SDR - PRINT UB-04 ;
+1 ;;2.6;IHS Third Party Billing;**1,2,4,6,9,10,11,13,19,20,21,22,23,25,27**;NOV 12, 2009;Build 486
+2 ;IHS/SD/SDR-2.6*20-HEAT262141-AHCCCS RX. Print detail lines for all meds, but won't print price, only NDC, desc, date, and units.
+3 ;IHS/SD/SDR-2.6*21-HEAT205579-Made T1015 print first for ARBOR HEALTH PLAN
+4 ;IHS/SD/SDR-2.6*21-HEAT268438-check for 61044 from 61004 for Medi-Cal
+5 ;IHS/SD/SDR-2.6*21-HEAT240744-call to resort,print lines for Medi-Cal dialysis billing
+6 ;IHS/SD/SDR 2.6*22 HEAT335246 chk new parm for printing itemized w/first line printing flat rate and NDC.
+7 ;IHS/SD/SDR 2.6*23 HEAT347035 Changed how it was getting rev code; made rev code print when Medi-Cal and there is chg on line item.
+8 ; Made change to ABMDF28S to ake T1015 print on the top line for Medi-Cal; it caused issue with ABMRV("ZZTOT" and ABMRV("NCTOT") so had to add $G to stop UNDEF
+9 ;IHS/SD/SDR 2.6*25 CR10016 correction to AZ Mcd 997 to make 0.00 print on all lines except first; first line prints flat rate;
+10 ; Also made change to have rev code print on every line even if chg is 0.00
+11 ;IHS/SD/AML,SDR 2.6*27 CR8897 Split to routine ABMDF28Q due to size. Made rev code print for AZ Mcd 997 claims
13 ; EP
+1 WRITE !
+2 KILL ABMR
+3 SET ABM("9SP")=" "
+4 NEW I
+5 FOR I=160:10:200
Begin DoDot:1
+6 DO @(I_"^ABMER41A")
End DoDot:1
+7 NEW I
+8 FOR I=210:10:390
Begin DoDot:1
+9 DO @(I_"^ABMER41")
End DoDot:1
+10 ;Policy holder st addr
+11 ;split abm*2.6*21
DO 38^ABMDF28V
+12 ;split abm*2.6*21
DO VALCDS1^ABMDF28V
14 ;
+1 WRITE !
+2 ;split abm*2.6*21
DO 38P2^ABMDF28V
+3 ;split abm*2.6*21
DO VALCDS2^ABMDF28V
+4 IF $GET(ABMORE)
QUIT
15 ;
+1 WRITE !
+2 KILL ABM
+3 ;split abm*2.6*21
DO VALCDS3^ABMDF28V
16 ;
+1 WRITE !
+2 ;split abm*2.6*21
DO VALCDS4^ABMDF28V
18 ;
+1 ;Lines 18-40 on form (desc area)
+2 ;ABMRV(IEN,code,cntr)=IEN^Code^Mod^2nd Mod^Total unts^Total chgs^^Unit chg^NDC name/desc^dt/tm
+3 WRITE !
+4 KILL ABMRV
+5 ;get other rev codes
DO ORV^ABMERGRV
+6 ;Build ABMVR of rev codes
DO P1^ABMERGRV
+7 ;Itemized UB-92 flag (1=yes, 0=no)
+8 SET ABMITMZ=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)
+9 ;abm*2.6*27 IHS/SD/SDR CR8897
SET ABMPOS=0
+10 ;Place of Service setup for facility ;abm*2.6*27 IHS/SD/SDR CR8897
IF "^51^52^53^54^55^"[("^"_$$GET1^DIQ(9002274.03,$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,6),".01","E")_"^")
SET ABMPOS=1
+11 ;abm*2.6*22 HEAT335246
IF (((ABMITMZ)&($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&($DATA(ABMP("FLAT")))!($$RCID^ABMUTLP(ABMP("INS")))["61044"))
DO START^ABMERGR4
KILL ABMP("FLAT")
+12 ;abm*2.6*21 HEAT240744
IF (($GET(ABMP("VTYP"))=721)!($PIECE($GET(^ABMDVTYP(ABMP("VTYP"),0)),U)["DIALYSIS"))
SET ABMDIAL=1
+13 ;dialysis ;abm*2.6*21 HEAT240744
IF ((+$GET(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044"))
DO COMPILE^ABMDF28S
+14 ;
+15 ;start new abm*2.6*27 IHS/SD/SDR CR8897
+16 KILL I,J,L
+17 SET I=0
+18 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:1
+19 SET J=-1
+20 FOR
SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:2
+21 SET L=0
+22 FOR
SET L=$ORDER(ABMRV(I,J,L))
IF +L=0
QUIT
Begin DoDot:3
+23 IF $PIECE($GET(ABMRV(I,J,L)),U,2)=""
QUIT
+24 SET ABMX("CPT",$PIECE(ABMRV(I,J,L),U,2))=+$GET(ABMX("CPT",$PIECE(ABMRV(I,J,L),U,2)))+1
End DoDot:3
End DoDot:2
End DoDot:1
+25 SET ABMX("CPT","FLG")=0
+26 SET I=""
+27 ;F S I=$O(ABMX("CPT",I)) Q:I="" D
+28 ;.I $G(ABMX("CPT",I))>1 S ABMX("CPT","FLG")=1
+29 ;I (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(+$G(ABMX("CPT","FLG"))=1) D ;if Medi-Cal and the same CPT multiple times
+30 ;if Medi-Cal
IF ($$RCID^ABMUTLP(ABMP("INS"))["61044")
Begin DoDot:1
+31 IF ((ABMP("VTYP")=142))&((ABMP("BTYP")=731))
DO 23CMPL^ABMDF28S
QUIT
+32 IF ((ABMPOS=1)&(ABMP("VTYP")=142))
DO 23CMPL^ABMDF28S
QUIT
+33 IF (($GET(ABMDIAL)'=1)&(ABMP("VTYP")'=142)&(ABMP("BTYP")'=731))
DO 23CMPL^ABMDF28S
QUIT
+34 IF ((ABMPOS=1)&(ABMP("BTYP")=731)&(ABMP("VTYP")'=142))
DO 23CMPL^ABMDF28S
End DoDot:1
+35 ;end new abm*2.6*27 IHS/SD/SDR CR8897
+36 ;
+37 KILL I,J,L
+38 ;put meds on 2 lines ;abm*2.6*21 split rtn
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,26)="Y"
DO 2LNMDS^ABMDF28S
+39 SET I=0
+40 ;split rtn abm*2.6*21
DO PGCNT^ABMDF28S
+41 ;start new abm*2.6*13 HEAT117086
+42 SET (ABMCTR,ABMRV("ZZTOT"),ABMRV("NCTOT"))=0
+43 ;abm*2.6*21 HEAT205579
DO T1015^ABMDF28S
+44 ;
+45 ;abm*2.6*27 IHS/SD/SDR CR8897 split routine
IF ABMP("ITYPE")="D"
DO ^ABMDF28Q
+46 ;
+47 ;abm*2.6*27 IHS/SD/SDR CR8897 split routine
DO ^ABMDF28P
+48 KILL I,J,L
+49 SET I=0
+50 SET ABMPGCNT=1
+51 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:1
+52 SET J=-1
+53 FOR
SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:2
+54 SET L=0
+55 FOR
SET L=$ORDER(ABMRV(I,J,L))
IF +L=0
QUIT
Begin DoDot:3
+56 IF 'ABMITMZ
IF J'="ZZTOT"
QUIT
+57 ;If itemized & done, Q
IF ABMITMZ
IF J="ZZTOT"
QUIT
+58 WRITE !
+59 ;Cnt items
SET ABMCTR=ABMCTR+1
+60 ;If >22 items, complete bottom of form, start new page
+61 IF ABMCTR>22
Begin DoDot:4
+62 SET ABMORE=1
+63 ;page#
SET ABMDE=ABMPGCNT_" "_ABMPGTOT_"^11^15"
+64 ;#43
DO WRT^ABMDF28W
+65 ;create dt
SET ABMDE=$$MDY^ABMDUTL($SELECT($GET(ABMP("PRINTDT"))="O":$PIECE($GET(^ABMDTXST(DUZ(2),$PIECE(^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))_"^45^20"
+66 DO WRT^ABMDF28W
+67 WRITE !
+68 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"))
+69 ;NPI-#56
SET ABMDE=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
+70 IF DUZ(2)=4610
IF ($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")="EDS/CDP")
SET ABMDE=1124150891
+71 SET ABMDE=ABMDE_"^68^15"
+72 DO WRT^ABMDF28W
+73 SET ABMPGCNT=ABMPGCNT+1
+74 NEW I,J
+75 DO 42
+76 DO ^ABMDF28Z
+77 WRITE $$EN^ABMVDF("IOF")
+78 NEW I,J
+79 DO 1^ABMDF28X
+80 KILL ABMORE
+81 NEW I
+82 FOR I=1:1:4
WRITE !
+83 SET ABMCTR=1
+84 QUIT
End DoDot:4
+85 ;S ABMDE=$$GETREV^ABMDUTL(I)_"^^4R" ;Rev code ;abm*2.6*23 HEAT347035
+86 ;Rev code ;abm*2.6*23 HEAT347035
SET ABMDE=$SELECT(($PIECE(ABMRV(I,J,L),U)'=0):$$GETREV^ABMDUTL($PIECE(ABMRV(I,J,L),U)),1:"")_"^^4R"
+87 ;abm*2.6*9 HEAT18507
IF L["."
SET ABMDE=""
+88 ;I $$RCID^ABMERUTL(ABMP("INS"))'=61004!((ABMP("VDT")>3100630)&($P($G(^AUTNINS(ABMP("INS"),0)),U)="EAPC")) D WRT^ABMDF28W ;#42 ;abm*2.6*21 HEAT268438
+89 ;I $$RCID^ABMERUTL(ABMP("INS"))'["61044"!((ABMP("VDT")>3100630)&($P($G(^AUTNINS(ABMP("INS"),0)),U)="EAPC")) D WRT^ABMDF28W ;#42 ;abm*2.6*21 HEAT268438 ;abm*2.6*23 HEAT347035
+90 ;I '(($$RCID^ABMERUTL(ABMP("INS"))["61044")&($D(ABMP("FLAT"))))&(+$P(ABMRV(I,J,L),U,6)'=0) D WRT^ABMDF28W ;abm*2.6*23 IHS/SD/SDR HEAT347035 ;abm*2.6*27 IHS/SD/SDR CR8897
+91 ;abm*2.6*25 IHS/SD/SDR CR10016
IF (($$RCID^ABMERUTL(ABMP("INS"))=99999)&(ABMP("VTYP")=997)&(+$PIECE(ABMRV(I,J,L),U,6)=0))
DO WRT^ABMDF28W
+92 ;#42 ;abm*2.6*21 HEAT268438 ;abm*2.6*23 HEAT347035
IF ((ABMP("VDT")>3100630)&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="EAPC"))
DO WRT^ABMDF28W
+93 ;start new abm*2.6*27 IHS/SD/SDR CR8897
+94 IF (($$RCID^ABMUTLP(ABMP("INS")))["61044")
Begin DoDot:4
+95 ;don't do this part if no rev code
IF +$PIECE(ABMRV(I,J,L),U)=0
QUIT
+96 IF ((ABMPOS=1)&((ABMP("BTYP")=731)!(ABMP("VTYP")'=142)))
SET ABMDE=$$GETREV^ABMDUTL($PIECE(ABMRV(I,J,L),U))_"^^4"
+97 IF '($DATA(ABMP("FLAT"))&(+$PIECE(ABMRV(I,J,L),U,6)'=0))
SET ABMDE=$$GETREV^ABMDUTL($PIECE(ABMRV(I,J,L),U))_"^^4"
+98 IF +$GET(ABMDIAL)=1
SET ABMDE="^^4"
+99 DO WRT^ABMDF28W
End DoDot:4
+100 IF ($$RCID^ABMUTLP(ABMP("INS"))'["61044")
DO WRT^ABMDF28W
+101 ;end new abm*2.6*27 IHS/SD/SDR CR8897
+102 ;If desc is blank, get it from vtyp in INS file
+103 IF $PIECE(ABMRV(I,J,L),U,9)=""
Begin DoDot:4
+104 ;quit if no rev code ;abm*2.6*23 HEAT347035
IF +$PIECE(ABMRV(I,J,L),U)=0
QUIT
+105 SET ABMDE=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,9)
+106 ;S:ABMDE="" ABMDE=$P($G(^AUTTREVN(I,0)),U,2) ;std abbrev ;abm*2.6*23 HEAT347035
+107 ;std abbrev ;abm*2.6*23 HEAT347035
IF ABMDE=""
SET ABMDE=$PIECE($GET(^AUTTREVN($PIECE(ABMRV(I,J,L),U),0)),U,2)
+108 ;Desc
SET ABMDE=ABMDE_"^5^24"
+109 ;I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&(J="Z6004")) S ABMDE="MAINTENANCE DIALYSIS WITH^5^25" ;abm*2.6*21 HEAT240744 ;broke between 21 and 26 so required a change ;abm*2.6*27 IHS/SD/SDR CR8897
+110 ;abm*2.6*21 HEAT240744 ;broke between 21 and 26 so required a change; abm*2.6*27 IHS/SD/SDR CR8897
IF ((+$GET(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&($PIECE(ABMRV(I,J,L),U,2)="Z6004"))
SET ABMDE="MAINTENANCE DIALYSIS WITH^5^25"
+111 ;don't print desc for Medi-Cal when charge amt is 0 ;abm*2.6*23 HEAT347035
IF (($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$PIECE(ABMRV(I,J,L),U,6)=0))
SET ABMDE="^^5^24"
+112 ;#43
DO WRT^ABMDF28W
+113 QUIT
End DoDot:4
+114 ;if desc, use it
IF $PIECE(ABMRV(I,J,L),U,9)'=""
Begin DoDot:4
+115 ;Desc
SET ABMDE=$PIECE(ABMRV(I,J,L),U,9)_"^5^24"
+116 ;don't print desc for Medi-Cal when charge amt is 0 ;abm*2.6*23 HEAT347035
IF (($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$PIECE(ABMRV(I,J,L),U,6)=0))
SET ABMDE="^^5^24"
+117 ;#43
DO WRT^ABMDF28W
+118 QUIT
End DoDot:4
+119 ;start new abm*2.6*27 IHS/SD/SDR CR8897 - note moved this up from further down to make info print on first line not last line
+120 SET ABMCAFLG=0
+121 IF ($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$GET(ABMITMZ))
Begin DoDot:4
+122 IF ((ABMPOS=1)&(ABMP("BTYP")=731)&(ABMP("VTYP")'=142))
SET ABMCAFLG=1
DO CALYRTC^ABMDF28S
+123 IF ((ABMP("BTYP")=731)&(ABMP("VTYP")=142))
SET ABMCAFLG=1
DO 23PRT^ABMDF28S
End DoDot:4
IF ABMCAFLG=1
QUIT
+124 ;end new abm*2.6*27 IHS/SD/SDR CR8897
+125 ;HCPCS/rates-#44
+126 SET ABMMODL=$SELECT($PIECE(ABMRV(I,J,L),U,3)]"":$PIECE(ABMRV(I,J,L),U,3),1:"")
+127 SET ABMMODL=ABMMODL_$SELECT($PIECE(ABMRV(I,J,L),U,4)]"":$PIECE(ABMRV(I,J,L),U,4),1:"")
+128 SET ABMMODL=ABMMODL_$SELECT($PIECE(ABMRV(I,J,L),U,12)]"":$PIECE(ABMRV(I,J,L),U,12),1:"")
+129 SET ABMDE=$SELECT($LENGTH($PIECE(ABMRV(I,J,L),U,2))>3:$PIECE(ABMRV(I,J,L),U,2)_ABMMODL_"^30^14",$PIECE(ABMRV(I,J,L),U,8)&(+$PIECE(ABMRV(I,J,L),U,2)'=0):$JUSTIFY($PIECE(ABMRV(I,J,L),U,8),1,2)_"^30^14R",+ABMMODL:$JUSTIFY(A
BMMODL,1,2)_"^30^14",1:"")
+130 ;make 2-digit CPT print for Medi-Cal
+131 ;abm*2.6*23 HEAT347035
IF $$RCID^ABMUTLP(ABMP("INS"))["61044"
Begin DoDot:4
+132 ;abm*2.6*23 HEAT347035
SET ABMDE=$SELECT($PIECE(ABMRV(I,J,L),U,2)'="":$PIECE(ABMRV(I,J,L),U,2)_ABMMODL_"^30^14",$PIECE(ABMRV(I,J,L),U,8)&(+$PIECE(ABMRV(I,J,L),U,2)'=0):$JUSTIFY($PIECE(ABMRV(I,J,L),U,8),1,2)_"^30^14R",+ABMMODL:$JUSTIFY(
ABMMODL,1,2)_"^30^14",1:"")
End DoDot:4
+133 IF $PIECE($GET(ABMRV(I,J,L)),U,14)'=""
IF ($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,24)="Y")
SET ABMDE="RX"_$PIECE(ABMRV(I,J,L),U,14)_"^30^9"
+134 ;deflt flat rate
IF ABMDE=""&($DATA(ABMP("FLAT"))!((I>99)&(I<250)))
SET ABMDE=$JUSTIFY($SELECT($DATA(ABMP("FLAT")):$PIECE(ABMP("FLAT"),U),1:$PIECE(ABMRV(I,J,L),U,8)),1,2)_"^30^14"
+135 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,20)="Y"
SET ABMDE="^30^14"
+136 ;I $$RCID^ABMERUTL(ABMP("INS"))=99999&(ABMP("VTYP")=997) S ABMDE=$S(ABMCTR=1:$J($P(ABMP("FLAT"),U),1,2),1:"")_"^30^14" ;abm*2.6*20 HEAT262141 ;abm*2.6*25 IHS/SD/SDR CR10016
+137 ;abm*2.6*20 HEAT262141 ;abm*2.6*25 IHS/SD/SDR CR10016
IF $$RCID^ABMERUTL(ABMP("INS"))=99999&(ABMP("VTYP")=997)
SET ABMDE=$SELECT(ABMCTR=1:$JUSTIFY($PIECE(ABMP("FLAT"),U),1,2),1:$JUSTIFY(0,1,2))_"^30^14R"
+138 ;I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&(J="Z6004")) S ABMDE="^30^14" ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/SDR CR8897
+139 ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/SDR CR8897
IF ((+$GET(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&($PIECE(ABMRV(I,J,L),U,2)="Z6004"))
SET ABMDE="^30^14"
+140 ;abm*2.6*27 IHS/SD/AML CR8897
IF (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(ABMP("BTYP")=731)&(ABMITMZ)&(+$GET(ABMCPTM)=0)
SET ABMDE="^30^14"
+141 DO WRT^ABMDF28W
+142 ;DOS
SET ABMDE=$$MDY^ABMDUTL($PIECE(ABMRV(I,J,L),U,10))_"^45^6"
+143 ;DOS ;abm*2.6*27 IHS/SD/SDR CR8897
IF (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(ABMP("BTYP")=731)
SET ABMDE=$$MDY^ABMDUTL($SELECT($PIECE(ABMRV(I,J,L),U,27):$PIECE(ABMRV(I,J,L),U,27),1:$PIECE(ABMRV(I,J,L),U,10)))_"^45^6"
+144 ;#45
DO WRT^ABMDF28W
+145 ;Tot units/item
SET ABMDE=$PIECE(ABMRV(I,J,L),U,5)_"^52^7R"
+146 ;I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&(J="Z6004")) S ABMDE="^52^7R" ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/SDR CR8897
+147 ;start new abm*2.6*27 IHS/SD/SDR CR8897
+148 IF ($$RCID^ABMUTLP(ABMP("INS"))["61044")
Begin DoDot:4
+149 IF ((+$GET(ABMDIAL)=1)&($PIECE(ABMRV(I,J,L),U,2)="Z6004"))
SET ABMDE="^52^7R"
+150 IF ((ABMP("BTYP")=731)&(ABMITMZ)&(+$GET(ABMCPTM)=0))
SET ABMDE="^52^7R"
+151 ;if Medi-Cal, no charge, and no units make units print 00
IF (($PIECE(ABMRV(I,J,L),U,5)=0)&($PIECE(ABMRV(I,J,L),U,6)=0))
SET ABMDE="00^52^7R"
End DoDot:4
+152 ;end new abm*2.6*27 IHS/SD/SDR CR8897
+153 ;#46
DO WRT^ABMDF28W
+154 SET ABMDE=$FNUMBER($PIECE(ABMRV(I,J,L),U,6),"T",2)
+155 ;Tot chg per item
SET ABMDE=$TRANSLATE(ABMDE,".")_"^61^9R"
+156 ;abm*2.6*9 HEAT18507
IF L["."
SET ABMDE=""
+157 IF $$RCID^ABMERUTL(ABMP("INS"))=99999&(ABMP("VTYP")=997)
SET ABMDE="^61^9R"
+158 ;I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")&(J="Z6004")) S ABMDE="^61^9R" ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/SDR CR8897
+159 ;start new abm*2.6*27 IHS/SD/SDR CR8897
+160 IF ($$RCID^ABMUTLP(ABMP("INS"))["61044")
Begin DoDot:4
+161 ;abm*2.6*21 HEAT240744
IF ((+$GET(ABMDIAL)=1)&($PIECE(ABMRV(I,J,L),U,2)="Z6004"))
SET ABMDE="^61^9R"
+162 IF ((ABMP("BTYP")=731)&(ABMITMZ)&(+$GET(ABMCPTM)=0))
SET ABMDE="^61^9R"
End DoDot:4
+163 ;end new abm*2.6*27 IHS/SD/SDR CR8897
+164 ;#47
DO WRT^ABMDF28W
+165 SET ABMDE=$FNUMBER($PIECE(ABMRV(I,J,L),U,7),"T",2)
+166 IF +ABMDE
Begin DoDot:4
+167 ;Tot noncover chgs/item
SET ABMDE=$TRANSLATE(ABMDE,".")_"^71^9R"
+168 ;#48
DO WRT^ABMDF28W
+169 QUIT
End DoDot:4
+170 ;I $G(ABMRV(I,J,L,1))'="" D Z6004PRT^ABMDF28S ;abm*2.6*21 HEAT240744 ;abm*2.6*27 IHS/SD/AML CR8897
+171 ;start new abm*2.6*27 IHS/SD/SDR CR8897
+172 IF ($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$GET(ABMITMZ))
Begin DoDot:4
+173 IF (($PIECE(ABMRV(I,J,L),U,2)="Z6004")&($GET(ABMRV(I,J,L,1))'="")&(ABMP("VTYP")'=142))
DO Z6004PRT^ABMDF28S
+174 ;I (ABMP("BTYP")=731)&(ABMP("VTYP")'=142) D CALYRTC^ABMDF28S
+175 ;I (ABMP("BTYP")=731)&(ABMP("VTYP")=142) D 23PRT^ABMDF28S
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+176 ;end new abm*2.6*27 IHS/SD/SDR CR8897
+177 ;abm*2.6*23 split rtn
DO 18A^ABMDF28R
+178 ;
42 ;
+1 ;abm*2.6*23 split rtn
DO 42^ABMDF28R
+2 QUIT
