- ABME5L4 ; IHS/ASDST/DMJ - Header
- ;;2.6;IHS Third Party Billing;**6,8,10,11,13,21**;NOV 12, 2009;Build 379
- ;Header Segments
- ;IHS/SD/SDR - 2.6*13 - Added DTP segments for Initial Treatment Date and Acute Manifestation Date
- ;IHS/SD/SDR - 2.6*21 - HEAT136508 - Made change so CLIA segment would print if lab code started with 'G'
- ;
- START ;START HERE
- K ABMOUTLB
- S ABMLOOP="2300"
- D ^ABME5CLM
- D WR^ABMUTL8("CLM")
- S ABMP("PDFN")=$P(ABMB0,U,5) ;Patient IEN
- ;I $P(ABMB8,U,6)'="" D ;onset of current illness or symptom ;abm*2.6*10 HEAT66142
- I $P(ABMB8,U,6)'="",($P(ABMB8,U,3)'="") D ;onset of current illness or symptom abm*2.6*10 HEAT66142
- .Q:$P(ABMB8,U,6)=$P(ABMB7,U) ;IHS/SD/SDR 5/21/12 HEAT69623
- .Q:$P(ABMB8,U,6)=$P(ABMB6,U) ;IHS/SD/AML 6/13/2012
- .D EP^ABME5DTP(431,"D8",$P(ABMB8,U,6))
- .D WR^ABMUTL8("DTP")
- ;start new code abm*2.6*13 exp mode 35 (454)
- I $P(ABMB8,"^",23) D
- .D EP^ABME5DTP(454,"D8",$P(ABMB8,"^",23)) ;Initial Treatment Date
- .D WR^ABMUTL8("DTP")
- ;end new code exp mode 35
- ;start new code abm*2.6*10 IHS/SD/AML HEAT79778
- I $P(ABMB9,"^",11) D
- .D EP^ABME5DTP(304,"D8",$P(ABMB9,"^",11)) ;Date last seen
- .D WR^ABMUTL8("DTP")
- .;end new code abm*2.6*10 IHS/SD/AML HEAT79778
- ;start new code abm*2.6*13 exp mode 35 (453)
- I $P(ABMB7,"^",27) D
- .D EP^ABME5DTP(453,"D8",$P(ABMB7,"^",27)) ;Acute Manifestation Date
- .D WR^ABMUTL8("DTP")
- ;end new code exp mode 35
- ;I $P(ABMB8,U,2) D ;accident ;abm*2.6*10 HEAT66142
- I $P(ABMB8,U,2),($P(ABMB8,U,3)'="") D ;accident ;abm*2.6*10 HEAT66142
- .D EP^ABME8DTP(439,"D8",$P(ABMB8,U,2))
- .D WR^ABMUTL8("DTP") ;abm*2.6*8 HEAT40129 - Write DPT segment if accident occurs
- I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),51)) D
- .S ABMP("51IEN")=0,ABMP("LMDT")=""
- .F S ABMP("51IEN")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMP("51IEN"))) Q:'ABMP("51IEN") D Q:($G(ABMP("LMDT"))'="")
- ..I $P($G(^ABMDCODE($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMP("51IEN"),0),U),0)),U)=10 D
- ...S ABMP("LMDT")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMP("51IEN"),0)),U,2)
- .I $G(ABMP("LMDT"))'="" D
- ..D EP^ABME5DTP(484,"D8",ABMP("LMDT"))
- ..D WR^ABMUTL8("DTP")
- I $P(ABMB9,U,13)'="" D
- .D EP^ABME5DTP(455,"D8",$P(ABMB9,U,13))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,"^",14) D
- .D EP^ABME5DTP(471,"D8",$P(ABMB7,"^",14))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,U,15)'=""&($P(ABMB7,U,16)'="") D
- .D EP^ABME5DTP(314,"RD8",$P(ABMB7,U,15),$P(ABMB7,U,16))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,U,15)'=""&($P(ABMB7,U,16)="") D
- .D EP^ABME5DTP(360,"D8",$P(ABMB7,U,15))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,U,15)=""&($P(ABMB7,U,16)'="") D
- .D EP^ABME5DTP(361,"D8",$P(ABMB7,U,16))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,U,17) D
- .D EP^ABME5DTP(297,"D8",$P(ABMB7,U,17))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,U,18) D
- .D EP^ABME5DTP(296,"D8",$P(ABMB7,U,18))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB6,U),($E(ABMP("BTYP"),1,2)=11) D
- .Q:$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,4)="Y"&($E($G(ABMP("BTYP")),1,2)'="11") ;dme billing
- .D EP^ABME8DTP(435,"D8",$P(ABMB6,U))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB6,"^",3),($E(ABMP("BTYP"),1,2)=11) D
- .D EP^ABME8DTP("096","D8",$P(ABMB6,"^",3))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,U,19) D
- .D EP^ABME5DTP("090","D8",$P(ABMB7,U,19))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,U,21) D
- .D EP^ABME5DTP("091","D8",$P(ABMB7,U,21))
- .D WR^ABMUTL8("DTP")
- I $P(ABMB7,U,22) D
- .D EP^ABME5DTP(444,"D8",$P(ABMB7,U,22))
- .D WR^ABMUTL8("DTP")
- I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),71)) D
- .K ABM71CNT
- .S ABM71IEN=0
- .F S ABM71IEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN)) Q:+ABM71IEN=0 D Q:$G(ABM71CNT)=10
- ..D ^ABME8PWK,WR^ABMUTL8("PWK")
- ..S ABM71CNT=+$G(ABM71CNT)+1
- I $P(ABMB7,U,23) D
- .D EP^ABME5AMT("F5")
- .D WR^ABMUTL8("AMT")
- I ABMP("CLIN")=72 D ;mammography
- .Q:$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)="" ;no cert#
- .D EP^ABME5REF("EW")
- .D WR^ABMUTL8("REF")
- I $P(ABMB5,U,11)'="" D
- .D EP^ABME5REF("9F")
- .D WR^ABMUTL8("REF")
- I $P(ABMB5,U,12)'="" D
- .D EP^ABME5REF("G1")
- .D WR^ABMUTL8("REF")
- I $P(ABMB4,U,9)'="" D
- .D EP^ABME5REF("F8")
- .D WR^ABMUTL8("REF")
- D ^ABMEHGRV
- S ABMCHK=0,ABMJ=0
- F ABMI=27,37,43 D
- .S ABMJ=-1
- .S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:ABMJ="" D
- ..S ABMK=0
- ..F S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:ABMK="" D
- ...;I $P(ABMRV(ABMI,ABMJ,ABMK),U,2)>79999,($P(ABMRV(ABMI,ABMJ,ABMK),U,2)<90000) S ABMCHK=1 ;abm*2.6*21 IHS/SD/SDR HEAT136508
- ...I ($P(ABMRV(ABMI,ABMJ,ABMK),U,2)>79999&($P(ABMRV(ABMI,ABMJ,ABMK),U,2)<90000))!($E($P(ABMRV(ABMI,ABMJ,ABMK),U,2))="G") S ABMCHK=1 ;abm*2.6*21 IHS/SD/SDR HEAT136508
- I ABMCHK=1 D
- .S ABMCLIA="CLM"
- .D EP^ABME5REF("X4","1CLM","1CLM")
- .D WR^ABMUTL8("REF")
- .K ABMCLIA,ABMCHK
- D EP^ABME5REF("EA")
- D WR^ABMUTL8("REF")
- I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61))!($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),10)),U)'="") D
- .D EP^ABME5NTE("ADD")
- .Q:$TR($G(ABMR("NTE",30))," ")="" ;don't write NTE if no data except spaces
- .D WR^ABMUTL8("NTE")
- I ABMP("CLIN")="A3" D
- .D EP^ABME5CR1
- .D WR^ABMUTL8("CR1")
- I $P(ABMB7,U,24)'="" D
- .D EP^ABME5CR2
- .D WR^ABMUTL8("CR2")
- ;ambulance certification
- I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,15)="Y",($D(^ABMDBILL(DUZ(2),ABMP("BDFN"),14))) D
- .D EP^ABME5CRC("AMB")
- .D WR^ABMUTL8("CRC")
- ;patient condition info:vision
- I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,21)'="" D
- .D EP^ABME5CRC("VIS")
- .D WR^ABMUTL8("CRC")
- ;EPSDT Referral
- I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0)) D
- .S ABMSPIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))
- .Q:+ABMSPIEN=0
- .Q:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABMSPIEN,0)),U,2)=""
- .D EP^ABME5CRC("EPSDT")
- .D WR^ABMUTL8("CRC")
- ;health care diagnosis code
- D DXSET^ABMUTL8(ABMP("BDFN"))
- ;D EP^ABME5HI("BZ")
- D EP^ABME5HI("BK")
- D WR^ABMUTL8("HI")
- ;anesthesia related procedure
- D ANES^ABMUTL8(ABMP("BDFN"))
- D EP^ABME5HI("BP")
- D WR^ABMUTL8("HI")
- ;condition information
- ;start old code abm*2.6*11 NOHEAT4
- ;D CDSET^ABMUTL8(ABMP("BDFN"))
- ;D EP^ABME8HI("BG")
- ;D WR^ABMUTL8("HI")
- ;end old code NOHEAT4
- Q
- ABME5L4 ; IHS/ASDST/DMJ - Header
- +1 ;;2.6;IHS Third Party Billing;**6,8,10,11,13,21**;NOV 12, 2009;Build 379
- +2 ;Header Segments
- +3 ;IHS/SD/SDR - 2.6*13 - Added DTP segments for Initial Treatment Date and Acute Manifestation Date
- +4 ;IHS/SD/SDR - 2.6*21 - HEAT136508 - Made change so CLIA segment would print if lab code started with 'G'
- +5 ;
- START ;START HERE
- +1 KILL ABMOUTLB
- +2 SET ABMLOOP="2300"
- +3 DO ^ABME5CLM
- +4 DO WR^ABMUTL8("CLM")
- +5 ;Patient IEN
- SET ABMP("PDFN")=$PIECE(ABMB0,U,5)
- +6 ;I $P(ABMB8,U,6)'="" D ;onset of current illness or symptom ;abm*2.6*10 HEAT66142
- +7 ;onset of current illness or symptom abm*2.6*10 HEAT66142
- IF $PIECE(ABMB8,U,6)'=""
- IF ($PIECE(ABMB8,U,3)'="")
- Begin DoDot:1
- +8 ;IHS/SD/SDR 5/21/12 HEAT69623
- IF $PIECE(ABMB8,U,6)=$PIECE(ABMB7,U)
- QUIT
- +9 ;IHS/SD/AML 6/13/2012
- IF $PIECE(ABMB8,U,6)=$PIECE(ABMB6,U)
- QUIT
- +10 DO EP^ABME5DTP(431,"D8",$PIECE(ABMB8,U,6))
- +11 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +12 ;start new code abm*2.6*13 exp mode 35 (454)
- +13 IF $PIECE(ABMB8,"^",23)
- Begin DoDot:1
- +14 ;Initial Treatment Date
- DO EP^ABME5DTP(454,"D8",$PIECE(ABMB8,"^",23))
- +15 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +16 ;end new code exp mode 35
- +17 ;start new code abm*2.6*10 IHS/SD/AML HEAT79778
- +18 IF $PIECE(ABMB9,"^",11)
- Begin DoDot:1
- +19 ;Date last seen
- DO EP^ABME5DTP(304,"D8",$PIECE(ABMB9,"^",11))
- +20 DO WR^ABMUTL8("DTP")
- +21 ;end new code abm*2.6*10 IHS/SD/AML HEAT79778
- End DoDot:1
- +22 ;start new code abm*2.6*13 exp mode 35 (453)
- +23 IF $PIECE(ABMB7,"^",27)
- Begin DoDot:1
- +24 ;Acute Manifestation Date
- DO EP^ABME5DTP(453,"D8",$PIECE(ABMB7,"^",27))
- +25 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +26 ;end new code exp mode 35
- +27 ;I $P(ABMB8,U,2) D ;accident ;abm*2.6*10 HEAT66142
- +28 ;accident ;abm*2.6*10 HEAT66142
- IF $PIECE(ABMB8,U,2)
- IF ($PIECE(ABMB8,U,3)'="")
- Begin DoDot:1
- +29 DO EP^ABME8DTP(439,"D8",$PIECE(ABMB8,U,2))
- +30 ;abm*2.6*8 HEAT40129 - Write DPT segment if accident occurs
- DO WR^ABMUTL8("DTP")
- End DoDot:1
- +31 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),51))
- Begin DoDot:1
- +32 SET ABMP("51IEN")=0
- SET ABMP("LMDT")=""
- +33 FOR
- SET ABMP("51IEN")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMP("51IEN")))
- IF 'ABMP("51IEN")
- QUIT
- Begin DoDot:2
- +34 IF $PIECE($GET(^ABMDCODE($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMP("51IEN"),0),U),0)),U)=10
- Begin DoDot:3
- +35 SET ABMP("LMDT")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMP("51IEN"),0)),U,2)
- End DoDot:3
- End DoDot:2
- IF ($GET(ABMP("LMDT"))'="")
- QUIT
- +36 IF $GET(ABMP("LMDT"))'=""
- Begin DoDot:2
- +37 DO EP^ABME5DTP(484,"D8",ABMP("LMDT"))
- +38 DO WR^ABMUTL8("DTP")
- End DoDot:2
- End DoDot:1
- +39 IF $PIECE(ABMB9,U,13)'=""
- Begin DoDot:1
- +40 DO EP^ABME5DTP(455,"D8",$PIECE(ABMB9,U,13))
- +41 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +42 IF $PIECE(ABMB7,"^",14)
- Begin DoDot:1
- +43 DO EP^ABME5DTP(471,"D8",$PIECE(ABMB7,"^",14))
- +44 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +45 IF $PIECE(ABMB7,U,15)'=""&($PIECE(ABMB7,U,16)'="")
- Begin DoDot:1
- +46 DO EP^ABME5DTP(314,"RD8",$PIECE(ABMB7,U,15),$PIECE(ABMB7,U,16))
- +47 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +48 IF $PIECE(ABMB7,U,15)'=""&($PIECE(ABMB7,U,16)="")
- Begin DoDot:1
- +49 DO EP^ABME5DTP(360,"D8",$PIECE(ABMB7,U,15))
- +50 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +51 IF $PIECE(ABMB7,U,15)=""&($PIECE(ABMB7,U,16)'="")
- Begin DoDot:1
- +52 DO EP^ABME5DTP(361,"D8",$PIECE(ABMB7,U,16))
- +53 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +54 IF $PIECE(ABMB7,U,17)
- Begin DoDot:1
- +55 DO EP^ABME5DTP(297,"D8",$PIECE(ABMB7,U,17))
- +56 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +57 IF $PIECE(ABMB7,U,18)
- Begin DoDot:1
- +58 DO EP^ABME5DTP(296,"D8",$PIECE(ABMB7,U,18))
- +59 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +60 IF $PIECE(ABMB6,U)
- IF ($EXTRACT(ABMP("BTYP"),1,2)=11)
- Begin DoDot:1
- +61 ;dme billing
- IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,4)="Y"&($EXTRACT($GET(ABMP("BTYP")),1,2)'="11")
- QUIT
- +62 DO EP^ABME8DTP(435,"D8",$PIECE(ABMB6,U))
- +63 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +64 IF $PIECE(ABMB6,"^",3)
- IF ($EXTRACT(ABMP("BTYP"),1,2)=11)
- Begin DoDot:1
- +65 DO EP^ABME8DTP("096","D8",$PIECE(ABMB6,"^",3))
- +66 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +67 IF $PIECE(ABMB7,U,19)
- Begin DoDot:1
- +68 DO EP^ABME5DTP("090","D8",$PIECE(ABMB7,U,19))
- +69 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +70 IF $PIECE(ABMB7,U,21)
- Begin DoDot:1
- +71 DO EP^ABME5DTP("091","D8",$PIECE(ABMB7,U,21))
- +72 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +73 IF $PIECE(ABMB7,U,22)
- Begin DoDot:1
- +74 DO EP^ABME5DTP(444,"D8",$PIECE(ABMB7,U,22))
- +75 DO WR^ABMUTL8("DTP")
- End DoDot:1
- +76 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),71))
- Begin DoDot:1
- +77 KILL ABM71CNT
- +78 SET ABM71IEN=0
- +79 FOR
- SET ABM71IEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN))
- IF +ABM71IEN=0
- QUIT
- Begin DoDot:2
- +80 DO ^ABME8PWK
- DO WR^ABMUTL8("PWK")
- +81 SET ABM71CNT=+$GET(ABM71CNT)+1
- End DoDot:2
- IF $GET(ABM71CNT)=10
- QUIT
- End DoDot:1
- +82 IF $PIECE(ABMB7,U,23)
- Begin DoDot:1
- +83 DO EP^ABME5AMT("F5")
- +84 DO WR^ABMUTL8("AMT")
- End DoDot:1
- +85 ;mammography
- IF ABMP("CLIN")=72
- Begin DoDot:1
- +86 ;no cert#
- IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)=""
- QUIT
- +87 DO EP^ABME5REF("EW")
- +88 DO WR^ABMUTL8("REF")
- End DoDot:1
- +89 IF $PIECE(ABMB5,U,11)'=""
- Begin DoDot:1
- +90 DO EP^ABME5REF("9F")
- +91 DO WR^ABMUTL8("REF")
- End DoDot:1
- +92 IF $PIECE(ABMB5,U,12)'=""
- Begin DoDot:1
- +93 DO EP^ABME5REF("G1")
- +94 DO WR^ABMUTL8("REF")
- End DoDot:1
- +95 IF $PIECE(ABMB4,U,9)'=""
- Begin DoDot:1
- +96 DO EP^ABME5REF("F8")
- +97 DO WR^ABMUTL8("REF")
- End DoDot:1
- +98 DO ^ABMEHGRV
- +99 SET ABMCHK=0
- SET ABMJ=0
- +100 FOR ABMI=27,37,43
- Begin DoDot:1
- +101 SET ABMJ=-1
- +102 SET ABMJ=$ORDER(ABMRV(ABMI,ABMJ))
- IF ABMJ=""
- QUIT
- Begin DoDot:2
- +103 SET ABMK=0
- +104 FOR
- SET ABMK=$ORDER(ABMRV(ABMI,ABMJ,ABMK))
- IF ABMK=""
- QUIT
- Begin DoDot:3
- +105 ;I $P(ABMRV(ABMI,ABMJ,ABMK),U,2)>79999,($P(ABMRV(ABMI,ABMJ,ABMK),U,2)<90000) S ABMCHK=1 ;abm*2.6*21 IHS/SD/SDR HEAT136508
- +106 ;abm*2.6*21 IHS/SD/SDR HEAT136508
- IF ($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,2)>79999&($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,2)<90000))!($EXTRACT($PIECE(ABMRV(ABMI,ABMJ,ABMK),U,2))="G")
- SET ABMCHK=1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +107 IF ABMCHK=1
- Begin DoDot:1
- +108 SET ABMCLIA="CLM"
- +109 DO EP^ABME5REF("X4","1CLM","1CLM")
- +110 DO WR^ABMUTL8("REF")
- +111 KILL ABMCLIA,ABMCHK
- End DoDot:1
- +112 DO EP^ABME5REF("EA")
- +113 DO WR^ABMUTL8("REF")
- +114 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),61))!($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),10)),U)'="")
- Begin DoDot:1
- +115 DO EP^ABME5NTE("ADD")
- +116 ;don't write NTE if no data except spaces
- IF $TRANSLATE($GET(ABMR("NTE",30))," ")=""
- QUIT
- +117 DO WR^ABMUTL8("NTE")
- End DoDot:1
- +118 IF ABMP("CLIN")="A3"
- Begin DoDot:1
- +119 DO EP^ABME5CR1
- +120 DO WR^ABMUTL8("CR1")
- End DoDot:1
- +121 IF $PIECE(ABMB7,U,24)'=""
- Begin DoDot:1
- +122 DO EP^ABME5CR2
- +123 DO WR^ABMUTL8("CR2")
- End DoDot:1
- +124 ;ambulance certification
- +125 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,15)="Y"
- IF ($DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),14)))
- Begin DoDot:1
- +126 DO EP^ABME5CRC("AMB")
- +127 DO WR^ABMUTL8("CRC")
- End DoDot:1
- +128 ;patient condition info:vision
- +129 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,21)'=""
- Begin DoDot:1
- +130 DO EP^ABME5CRC("VIS")
- +131 DO WR^ABMUTL8("CRC")
- End DoDot:1
- +132 ;EPSDT Referral
- +133 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))
- Begin DoDot:1
- +134 SET ABMSPIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))
- +135 IF +ABMSPIEN=0
- QUIT
- +136 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABMSPIEN,0)),U,2)=""
- QUIT
- +137 DO EP^ABME5CRC("EPSDT")
- +138 DO WR^ABMUTL8("CRC")
- End DoDot:1
- +139 ;health care diagnosis code
- +140 DO DXSET^ABMUTL8(ABMP("BDFN"))
- +141 ;D EP^ABME5HI("BZ")
- +142 DO EP^ABME5HI("BK")
- +143 DO WR^ABMUTL8("HI")
- +144 ;anesthesia related procedure
- +145 DO ANES^ABMUTL8(ABMP("BDFN"))
- +146 DO EP^ABME5HI("BP")
- +147 DO WR^ABMUTL8("HI")
- +148 ;condition information
- +149 ;start old code abm*2.6*11 NOHEAT4
- +150 ;D CDSET^ABMUTL8(ABMP("BDFN"))
- +151 ;D EP^ABME8HI("BG")
- +152 ;D WR^ABMUTL8("HI")
- +153 ;end old code NOHEAT4
- +154 QUIT
