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

ABMDF28Y.m

Go to the documentation of this file. 
  1. 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
  1.  ;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.
  1.  ;IHS/SD/SDR-2.6*21-HEAT205579-Made T1015 print first for ARBOR HEALTH PLAN
  1.  ;IHS/SD/SDR-2.6*21-HEAT268438-check for 61044 from 61004 for Medi-Cal
  1.  ;IHS/SD/SDR-2.6*21-HEAT240744-call to resort,print lines for Medi-Cal dialysis billing
  1.  ;IHS/SD/SDR 2.6*22 HEAT335246 chk new parm for printing itemized w/first line printing flat rate and NDC.
  1.  ;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.
  1.  ;  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
  1.  ;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;
  1.  ;  Also made change to have rev code print on every line even if chg is 0.00
  1.  ;IHS/SD/AML,SDR 2.6*27 CR8897 Split to routine ABMDF28Q due to size.  Made rev code print for AZ Mcd 997 claims
  1. 13 ; EP
  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 st addr
  1.  D 38^ABMDF28V  ;split abm*2.6*21
  1.  D VALCDS1^ABMDF28V  ;split abm*2.6*21
  1. 14 ;
  1.  W !
  1.  D 38P2^ABMDF28V  ;split abm*2.6*21
  1.  D VALCDS2^ABMDF28V  ;split abm*2.6*21
  1.  Q:$G(ABMORE)
  1. 15 ;
  1.  W !
  1.  K ABM
  1.  D VALCDS3^ABMDF28V  ;split abm*2.6*21
  1. 16 ;
  1.  W !
  1.  D VALCDS4^ABMDF28V  ;split abm*2.6*21
  1. 18 ;
  1.  ;Lines 18-40 on form (desc area)
  1.  ;ABMRV(IEN,code,cntr)=IEN^Code^Mod^2nd Mod^Total unts^Total chgs^^Unit chg^NDC name/desc^dt/tm
  1.  W !
  1.  K ABMRV
  1.  D ORV^ABMERGRV  ;get other rev codes
  1.  D P1^ABMERGRV  ;Build ABMVR of rev codes
  1.  ;Itemized UB-92 flag (1=yes, 0=no)
  1.  S ABMITMZ=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)
  1.  S ABMPOS=0  ;abm*2.6*27 IHS/SD/SDR CR8897
  1.  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
  1.  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
  1.  I (($G(ABMP("VTYP"))=721)!($P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)["DIALYSIS")) S ABMDIAL=1  ;abm*2.6*21 HEAT240744
  1.  I ((+$G(ABMDIAL)=1)&(($$RCID^ABMUTLP(ABMP("INS")))["61044")) D COMPILE^ABMDF28S  ;dialysis  ;abm*2.6*21 HEAT240744
  1.  ;
  1.  ;start new abm*2.6*27 IHS/SD/SDR CR8897
  1.  K I,J,L
  1.  S I=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.  ...Q:$P($G(ABMRV(I,J,L)),U,2)=""
  1.  ...S ABMX("CPT",$P(ABMRV(I,J,L),U,2))=+$G(ABMX("CPT",$P(ABMRV(I,J,L),U,2)))+1
  1.  S ABMX("CPT","FLG")=0
  1.  S I=""
  1.  ;F  S I=$O(ABMX("CPT",I)) Q:I=""  D
  1.  ;.I $G(ABMX("CPT",I))>1 S ABMX("CPT","FLG")=1
  1.  ;I (($$RCID^ABMUTLP(ABMP("INS")))["61044")&(+$G(ABMX("CPT","FLG"))=1) D  ;if Medi-Cal and the same CPT multiple times
  1.  I ($$RCID^ABMUTLP(ABMP("INS"))["61044") D  ;if Medi-Cal
  1.  .I ((ABMP("VTYP")=142))&((ABMP("BTYP")=731)) D 23CMPL^ABMDF28S Q
  1.  .I ((ABMPOS=1)&(ABMP("VTYP")=142)) D 23CMPL^ABMDF28S Q
  1.  .I (($G(ABMDIAL)'=1)&(ABMP("VTYP")'=142)&(ABMP("BTYP")'=731)) D 23CMPL^ABMDF28S Q
  1.  .I ((ABMPOS=1)&(ABMP("BTYP")=731)&(ABMP("VTYP")'=142)) D 23CMPL^ABMDF28S
  1.  ;end new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ; 
  1.  K I,J,L
  1.  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
  1.  S I=0
  1.  D PGCNT^ABMDF28S  ;split rtn abm*2.6*21
  1.  ;start new abm*2.6*13 HEAT117086
  1.  S (ABMCTR,ABMRV("ZZTOT"),ABMRV("NCTOT"))=0
  1.  D T1015^ABMDF28S  ;abm*2.6*21 HEAT205579
  1.  ;
  1.  I ABMP("ITYPE")="D" D ^ABMDF28Q  ;abm*2.6*27 IHS/SD/SDR CR8897 split routine
  1.  ;
  1.  D ^ABMDF28P  ;abm*2.6*27 IHS/SD/SDR CR8897 split routine
  1.  K I,J,L
  1.  S I=0
  1.  S ABMPGCNT=1
  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.  ...I 'ABMITMZ,J'="ZZTOT" Q
  1.  ...I ABMITMZ,J="ZZTOT" Q  ;If itemized & done, Q
  1.  ...W !
  1.  ...S ABMCTR=ABMCTR+1  ;Cnt items
  1.  ...;If >22 items, complete bottom of form, start new page
  1.  ...I ABMCTR>22 D
  1.  ....S ABMORE=1
  1.  ....S ABMDE=ABMPGCNT_"    "_ABMPGTOT_"^11^15"  ;page#
  1.  ....D WRT^ABMDF28W  ;#43
  1.  ....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
  1.  ....D WRT^ABMDF28W
  1.  ....W !
  1.  ....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"))
  1.  ....S ABMDE=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")  ;NPI-#56
  1.  ....I DUZ(2)=4610,($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")="EDS/CDP") S ABMDE=1124150891
  1.  ....S ABMDE=ABMDE_"^68^15"
  1.  ....D WRT^ABMDF28W
  1.  ....S ABMPGCNT=ABMPGCNT+1
  1.  ....N I,J
  1.  ....D 42
  1.  ....D ^ABMDF28Z
  1.  ....W $$EN^ABMVDF("IOF")
  1.  ....N I,J
  1.  ....D 1^ABMDF28X
  1.  ....K ABMORE
  1.  ....N I
  1.  ....F I=1:1:4 W !
  1.  ....S ABMCTR=1
  1.  ....Q
  1.  ...;S ABMDE=$$GETREV^ABMDUTL(I)_"^^4R"  ;Rev code  ;abm*2.6*23 HEAT347035
  1.  ...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
  1.  ...I L["." S ABMDE=""  ;abm*2.6*9 HEAT18507
  1.  ...;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
  1.  ...;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
  1.  ...;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
  1.  ...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
  1.  ...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
  1.  ...;start new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ...I (($$RCID^ABMUTLP(ABMP("INS")))["61044") D
  1.  ....I +$P(ABMRV(I,J,L),U)=0 Q  ;don't do this part if no rev code
  1.  ....I ((ABMPOS=1)&((ABMP("BTYP")=731)!(ABMP("VTYP")'=142))) S ABMDE=$$GETREV^ABMDUTL($P(ABMRV(I,J,L),U))_"^^4"
  1.  ....I '($D(ABMP("FLAT"))&(+$P(ABMRV(I,J,L),U,6)'=0)) S ABMDE=$$GETREV^ABMDUTL($P(ABMRV(I,J,L),U))_"^^4"
  1.  ....I +$G(ABMDIAL)=1 S ABMDE="^^4"
  1.  ....D WRT^ABMDF28W
  1.  ...I ($$RCID^ABMUTLP(ABMP("INS"))'["61044") D WRT^ABMDF28W
  1.  ...;end new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ...;If desc is blank, get it from vtyp in INS file
  1.  ...I $P(ABMRV(I,J,L),U,9)="" D
  1.  ....Q:+$P(ABMRV(I,J,L),U)=0  ;quit if no rev code  ;abm*2.6*23 HEAT347035
  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)  ;std abbrev  ;abm*2.6*23 HEAT347035
  1.  ....S:ABMDE="" ABMDE=$P($G(^AUTTREVN($P(ABMRV(I,J,L),U),0)),U,2)  ;std abbrev  ;abm*2.6*23 HEAT347035
  1.  ....S ABMDE=ABMDE_"^5^24"  ;Desc
  1.  ....;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
  1.  ....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
  1.  ....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
  1.  ....D WRT^ABMDF28W  ;#43
  1.  ....Q
  1.  ...I $P(ABMRV(I,J,L),U,9)'="" D  ;if desc, use it
  1.  ....S ABMDE=$P(ABMRV(I,J,L),U,9)_"^5^24"  ;Desc
  1.  ....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
  1.  ....D WRT^ABMDF28W  ;#43
  1.  ....Q
  1.  ...;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
  1.  ...S ABMCAFLG=0
  1.  ...I ($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$G(ABMITMZ)) D  I ABMCAFLG=1 Q
  1.  ....I ((ABMPOS=1)&(ABMP("BTYP")=731)&(ABMP("VTYP")'=142)) S ABMCAFLG=1 D CALYRTC^ABMDF28S
  1.  ....I ((ABMP("BTYP")=731)&(ABMP("VTYP")=142)) S ABMCAFLG=1 D 23PRT^ABMDF28S
  1.  ...;end new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ...;HCPCS/rates-#44
  1.  ...S ABMMODL=$S($P(ABMRV(I,J,L),U,3)]"":$P(ABMRV(I,J,L),U,3),1:"")
  1.  ...S ABMMODL=ABMMODL_$S($P(ABMRV(I,J,L),U,4)]"":$P(ABMRV(I,J,L),U,4),1:"")
  1.  ...S ABMMODL=ABMMODL_$S($P(ABMRV(I,J,L),U,12)]"":$P(ABMRV(I,J,L),U,12),1:"")
  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:"")
  1.  ...;make 2-digit CPT print for Medi-Cal
  1.  ...I $$RCID^ABMUTLP(ABMP("INS"))["61044" D  ;abm*2.6*23 HEAT347035
  1.  ....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
  1.  ...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"
  1.  ...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
  1.  ...I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,20)="Y" S ABMDE="^30^14"
  1.  ...;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
  1.  ...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
  1.  ...;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
  1.  ...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
  1.  ...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
  1.  ...D WRT^ABMDF28W
  1.  ...S ABMDE=$$MDY^ABMDUTL($P(ABMRV(I,J,L),U,10))_"^45^6"  ;DOS
  1.  ...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
  1.  ...D WRT^ABMDF28W  ;#45
  1.  ...S ABMDE=$P(ABMRV(I,J,L),U,5)_"^52^7R"  ;Tot units/item
  1.  ...;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
  1.  ...;start new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ...I ($$RCID^ABMUTLP(ABMP("INS"))["61044") D
  1.  ....I ((+$G(ABMDIAL)=1)&($P(ABMRV(I,J,L),U,2)="Z6004")) S ABMDE="^52^7R"
  1.  ....I ((ABMP("BTYP")=731)&(ABMITMZ)&(+$G(ABMCPTM)=0)) S ABMDE="^52^7R"
  1.  ....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
  1.  ...;end new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ...D WRT^ABMDF28W  ;#46
  1.  ...S ABMDE=$FN($P(ABMRV(I,J,L),U,6),"T",2)
  1.  ...S ABMDE=$TR(ABMDE,".")_"^61^9R"  ;Tot chg per item
  1.  ...I L["." S ABMDE=""  ;abm*2.6*9 HEAT18507
  1.  ...I $$RCID^ABMERUTL(ABMP("INS"))=99999&(ABMP("VTYP")=997) S ABMDE="^61^9R"
  1.  ...;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
  1.  ...;start new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ...I ($$RCID^ABMUTLP(ABMP("INS"))["61044") D
  1.  ....I ((+$G(ABMDIAL)=1)&($P(ABMRV(I,J,L),U,2)="Z6004")) S ABMDE="^61^9R"  ;abm*2.6*21 HEAT240744
  1.  ....I ((ABMP("BTYP")=731)&(ABMITMZ)&(+$G(ABMCPTM)=0)) S ABMDE="^61^9R"
  1.  ...;end new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ...D WRT^ABMDF28W  ;#47
  1.  ...S ABMDE=$FN($P(ABMRV(I,J,L),U,7),"T",2)
  1.  ...I +ABMDE D
  1.  ....S ABMDE=$TR(ABMDE,".")_"^71^9R"  ;Tot noncover chgs/item
  1.  ....D WRT^ABMDF28W  ;#48
  1.  ....Q
  1.  ...;I $G(ABMRV(I,J,L,1))'="" D Z6004PRT^ABMDF28S  ;abm*2.6*21 HEAT240744  ;abm*2.6*27 IHS/SD/AML CR8897
  1.  ...;start new abm*2.6*27 IHS/SD/SDR CR8897
  1.  ...I ($$RCID^ABMUTLP(ABMP("INS"))["61044")&(+$G(ABMITMZ)) D
  1.  ....I (($P(ABMRV(I,J,L),U,2)="Z6004")&($G(ABMRV(I,J,L,1))'="")&(ABMP("VTYP")'=142)) D Z6004PRT^ABMDF28S
  1.  ....;I (ABMP("BTYP")=731)&(ABMP("VTYP")'=142) D CALYRTC^ABMDF28S
  1.  ....;I (ABMP("BTYP")=731)&(ABMP("VTYP")=142) D 23PRT^ABMDF28S
  1.  ;end new abm*2.6*27 IHS/SD/SDR CR8897
  1.  D 18A^ABMDF28R  ;abm*2.6*23 split rtn
  1.  ;
  1. 42 ;
  1.  D 42^ABMDF28R  ;abm*2.6*23 split rtn
  1.  Q