ABMER70 ; IHS/ASDST/DMJ - UB92 EMC RECORD 70-1 (Medical) ;
;;2.6;IHS 3P BILLING SYSTEM;**3,17**;NOV 12, 2009;Build 272
;Original;DMJ;08/18/95 10:07 AM
;
; IHS/ASDS/DMJ - 11/17/00 - V2.4 Patch 3 - NOIS NDA-0500-180002
; Modified code to allow printing of E-codes if exist.
;
; IHS/SD/SDR - v2.5 p10 - IM20338 - Fix check for ICDs
; IHS/SD/SDR - v2.5 p13 - POA changes
;
; IHS/SD/SDR - v2.6 CSV
; IHS/SD/SDR - abm*2.6*3 - HEAT11931 - fix for INVALI displaying in box 72
;IHS/SD/SDR - 2.6*17 - HEAT238640 - Updated all DX fields to hold 7 characters instead of 6.
;
START ;START HERE
K ABMR(70),ABMREC(70)
S ABME("RTYPE")=70
D SET^ABMERUTL,LOOP
D S90^ABMERUTL
K ABM,ABME
Q
;
LOOP ;LOOP HERE
D ^ABMER70A
F I=130:10:300 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),70,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(70)=$G(ABMREC(70))_ABMR(70,I)
Q
;
130 ;Principle Surgical Procedure Code (SOURCE: FILE=9002274.4 FIELD=)
; form locator #80
D SCODE
S ABMR(70,130)=$P(ABM("SC",1),U)
S ABMR(70,130)=$$FMT^ABMERUTL(ABMR(70,130),7)
Q
;
140 ;Principle Surgical Procedure Date (SOURCE: FILE=9002274.4 FIELD=)
; form locator #80
D SCODE
S Y=$P(ABM("SC",1),"^",2) D DFMT^ABMERUTL S ABMR(70,140)=Y
S ABMR(70,140)=$$FMT^ABMERUTL(ABMR(70,140),6)
Q
;
150 ;Other Surgical Procedure Code #1 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S ABMR(70,150)=$P(ABM("SC",2),U)
S ABMR(70,150)=$$FMT^ABMERUTL(ABMR(70,150),7)
Q
;
160 ;Other Surgical Procedure Date #1 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",2),"^",2)
D DFMT^ABMERUTL
S ABMR(70,160)=Y
S ABMR(70,160)=$$FMT^ABMERUTL(ABMR(70,160),6)
Q
;
170 ;Other Surgical Procedure Code #2 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S ABMR(70,170)=$P(ABM("SC",3),U)
S ABMR(70,170)=$$FMT^ABMERUTL(ABMR(70,170),7)
Q
180 ;Other Surgical Procedure Date #2 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",3),"^",2)
D DFMT^ABMERUTL
S ABMR(70,180)=Y
S ABMR(70,180)=$$FMT^ABMERUTL(ABMR(70,180),6)
Q
;
190 ;Other Surgical Procedure Code #3 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S ABMR(70,190)=$P(ABM("SC",4),U)
S ABMR(70,190)=$$FMT^ABMERUTL(ABMR(70,190),7)
Q
;
200 ;Other Surgical Procedure Date #3 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",4),"^",2)
D DFMT^ABMERUTL
S ABMR(70,200)=Y
S ABMR(70,200)=$$FMT^ABMERUTL(ABMR(70,200),6)
Q
;
210 ;Other Surgical Procedure Code #4 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S ABMR(70,210)=$P(ABM("SC",5),U)
S ABMR(70,210)=$$FMT^ABMERUTL(ABMR(70,210),7)
Q
;
220 ;Other Surgical Procedure Date #4 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",5),"^",2)
D DFMT^ABMERUTL
S ABMR(70,220)=Y
S ABMR(70,220)=$$FMT^ABMERUTL(ABMR(70,220),6)
Q
;
230 ;Other Surgical Procedure Code #5 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S ABMR(70,230)=$P(ABM("SC",6),U)
S ABMR(70,230)=$$FMT^ABMERUTL(ABMR(70,230),7)
Q
;
240 ;Other Surgical Procedure Date #5 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",6),"^",2)
D DFMT^ABMERUTL
S ABMR(70,240)=Y
S ABMR(70,240)=$$FMT^ABMERUTL(ABMR(70,240),6)
Q
;
250 ;Admitting Diagnosis (SOURCE: FILE=9002274.4, FIELD=.59)
; form locator #76
D:'$D(ABM(9002274.4,ABMP("BDFN"),.59)) DIQ1
S ABMR(70,250)=ABM(9002274.4,ABMP("BDFN"),.59,"E")
S ABMR(70,250)=$TR(ABMR(70,250),".")
;S ABMR(70,250)=$$FMT^ABMERUTL(ABMR(70,250),6) ;abm*2.6*17 IHS/SD/SDR HEAT238640
S ABMR(70,250)=$$FMT^ABMERUTL(ABMR(70,250),7) ;abm*2.6*17 IHS/SD/SDR HEAT238640
Q
;
260 ;External Cause of Injury (SOURCE: FILE=9002274.4, FIELD=)
; form locator #77
S ABMR(70,260)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",12)
;S ABMR(70,260)=$P($$DX^ABMCVAPI(+ABMR(70,260),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
S:(+ABMR(70,260)) ABMR(70,260)=$P($$DX^ABMCVAPI(+ABMR(70,260),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
S ABMR(70,260,"POA")=$$POA(ABMR(70,260))
S ABMR(70,260)=$TR($G(ABMR(70,260)),".")
;S ABMR(70,260)=$$FMT^ABMERUTL(ABMR(70,260),6) ;abm*2.6*17 IHS/SD/SDR HEAT238640
S ABMR(70,260)=$$FMT^ABMERUTL(ABMR(70,260),7) ;abm*2.6*17 IHS/SD/SDR HEAT238640
Q
;
270 ;Procedure Coding Method Used (SOURCE: FILE=9999999.18, FIELD=)
; form locator #79
I +$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,0))'=0 S ABMR(70,270)=9
E S ABMR(70,270)=$S($P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),U,2)="I":9,1:4)
S ABMR(70,270)=$$FMT^ABMERUTL(ABMR(70,270),"1N")
Q
;
280 ;Filler
S ABMR(70,280)=""
S ABMR(70,280)=$$FMT^ABMERUTL(ABMR(70,280),23)
Q
290 ;External Cause of Injury (2) (SOURCE: FILE=9002274.4, FIELD=)
; form locator #77
S ABMR(70,290)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,19)
;S ABMR(70,290)=$P($$DX^ABMCVAPI(+ABMR(70,290),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
S:(+ABMR(70,290)) ABMR(70,290)=$P($$DX^ABMCVAPI(+ABMR(70,290),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
S ABMR(70,290,"POA")=$$POA(ABMR(70,290))
S ABMR(70,290)=$TR($G(ABMR(70,290)),".")
;S ABMR(70,290)=$$FMT^ABMERUTL(ABMR(70,290),6) ;abm*2.6*17 IHS/SD/SDR HEAT238640
S ABMR(70,290)=$$FMT^ABMERUTL(ABMR(70,290),7) ;abm*2.6*17 IHS/SD/SDR HEAT238640
Q
300 ;External Cause of Injury (3) (SOURCE: FILE=9002274.4, FIELD=)
; form locator #77
S ABMR(70,300)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,20)
;S ABMR(70,300)=$P($$DX^ABMCVAPI(+ABMR(70,300),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
S:(+ABMR(70,300)) ABMR(70,300)=$P($$DX^ABMCVAPI(+ABMR(70,300),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
S ABMR(70,300,"POA")=$$POA(ABMR(70,300))
S ABMR(70,300)=$TR($G(ABMR(70,300)),".")
;S ABMR(70,300)=$$FMT^ABMERUTL(ABMR(70,300),6) ;abm*2.6*17 IHS/SD/SDR HEAT238640
S ABMR(70,300)=$$FMT^ABMERUTL(ABMR(70,300),7) ;abm*2.6*17 IHS/SD/SDR HEAT238640
Q
;
SCODE ;SURGICAL PROCEDURE CODES
Q:$D(ABM("SC")) ; Quit if already done
N I
S I=0,CNT=0
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,"C",I)) Q:+I=0 D
.S J=0
.F S J=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,"C",I,J)) Q:+J=0 D
..S CNT=CNT+1
..S ABM("ZERO")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,J,0))
..S ABM("SC",CNT)=$P($$ICDOP^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$P(ABM("ZERO"),U,3) ;CSV-c
..Q:$P($G(^ABMDEXP(ABMP("EXP"),1)),U,5)'="E"
..S ABM("SC",CNT)=$TR(ABM("SC",CNT),".")
I $D(ABM("SC")) F I=1:1:6 S:'$D(ABM("SC",I)) ABM("SC",I)=""
Q:$D(ABM("SC"))
; if procedure coding method used is ICD use node 19,
; else use node 21 (Med/Surg)
S ABM("SUB")=$S($P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),"^",2)="I":19,1:21)
N I
S I=0,CNT=0
; loop INS priority order
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),"C",I)) Q:'I D
.N J
.S J=0
.; Loop IEN to multiple
.F S J=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),"C",I,J)) Q:'J D
..S CNT=CNT+1 ; increment counter
..S ABM("ZERO")=^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),J,0)
..I ABM("SUB")=19 D ; ICD procedure code ^ date of service
...S ABM("SC",CNT)=$P($$ICDOP^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$P(ABM("ZERO"),U,3) ;CSV-c
...Q:$P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"
...S ABM("SC",CNT)=$TR(ABM("SC",CNT),".")
..; CPT code ^ date/time
..I ABM("SUB")=21 S ABM("SC",CNT)=$P($$CPT^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$P(ABM("ZERO"),U,5) ;CSV-c
F I=1:1:6 S:'$D(ABM("SC",I)) ABM("SC",I)=""
Q
;
DIQ1 ;GET INFO FROM FILE 9002274.4
N I
S DA=ABMP("BDFN")
S DR=".59;.857"
S DIQ="ABM"
S DIQ(0)="E"
S DIC="^ABMDBILL(DUZ(2),"
D EN^DIQ1
K DIQ
Q
;
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
;
; INPUT: ABMX = data element
; Y = bill internal entry number
;
; OUTPUT: Y = bill internal entry number
;
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(70,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(70,ABMX),ABMX,ABMY
Q Y
POA(ABMDX) ;EP
N I
S I=0
S ABMRPOA=""
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I)) Q:'I D
.I ABMDX=$P($G(^ICD9($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I,0)),U),0)),U) S ABMRPOA=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I,0)),U,5)
Q ABMRPOA
ABMER70 ; IHS/ASDST/DMJ - UB92 EMC RECORD 70-1 (Medical) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,17**;NOV 12, 2009;Build 272
+2 ;Original;DMJ;08/18/95 10:07 AM
+3 ;
+4 ; IHS/ASDS/DMJ - 11/17/00 - V2.4 Patch 3 - NOIS NDA-0500-180002
+5 ; Modified code to allow printing of E-codes if exist.
+6 ;
+7 ; IHS/SD/SDR - v2.5 p10 - IM20338 - Fix check for ICDs
+8 ; IHS/SD/SDR - v2.5 p13 - POA changes
+9 ;
+10 ; IHS/SD/SDR - v2.6 CSV
+11 ; IHS/SD/SDR - abm*2.6*3 - HEAT11931 - fix for INVALI displaying in box 72
+12 ;IHS/SD/SDR - 2.6*17 - HEAT238640 - Updated all DX fields to hold 7 characters instead of 6.
+13 ;
START ;START HERE
+1 KILL ABMR(70),ABMREC(70)
+2 SET ABME("RTYPE")=70
+3 DO SET^ABMERUTL
DO LOOP
+4 DO S90^ABMERUTL
+5 KILL ABM,ABME
+6 QUIT
+7 ;
LOOP ;LOOP HERE
+1 DO ^ABMER70A
+2 FOR I=130:10:300
Begin DoDot:1
+3 DO @I
+4 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),70,I))
DO @(^(I))
+5 IF '$GET(ABMP("NOFMT"))
SET ABMREC(70)=$GET(ABMREC(70))_ABMR(70,I)
End DoDot:1
+6 QUIT
+7 ;
130 ;Principle Surgical Procedure Code (SOURCE: FILE=9002274.4 FIELD=)
+1 ; form locator #80
+2 DO SCODE
+3 SET ABMR(70,130)=$PIECE(ABM("SC",1),U)
+4 SET ABMR(70,130)=$$FMT^ABMERUTL(ABMR(70,130),7)
+5 QUIT
+6 ;
140 ;Principle Surgical Procedure Date (SOURCE: FILE=9002274.4 FIELD=)
+1 ; form locator #80
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",1),"^",2)
DO DFMT^ABMERUTL
SET ABMR(70,140)=Y
+4 SET ABMR(70,140)=$$FMT^ABMERUTL(ABMR(70,140),6)
+5 QUIT
+6 ;
150 ;Other Surgical Procedure Code #1 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET ABMR(70,150)=$PIECE(ABM("SC",2),U)
+4 SET ABMR(70,150)=$$FMT^ABMERUTL(ABMR(70,150),7)
+5 QUIT
+6 ;
160 ;Other Surgical Procedure Date #1 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",2),"^",2)
+4 DO DFMT^ABMERUTL
+5 SET ABMR(70,160)=Y
+6 SET ABMR(70,160)=$$FMT^ABMERUTL(ABMR(70,160),6)
+7 QUIT
+8 ;
170 ;Other Surgical Procedure Code #2 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET ABMR(70,170)=$PIECE(ABM("SC",3),U)
+4 SET ABMR(70,170)=$$FMT^ABMERUTL(ABMR(70,170),7)
+5 QUIT
180 ;Other Surgical Procedure Date #2 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",3),"^",2)
+4 DO DFMT^ABMERUTL
+5 SET ABMR(70,180)=Y
+6 SET ABMR(70,180)=$$FMT^ABMERUTL(ABMR(70,180),6)
+7 QUIT
+8 ;
190 ;Other Surgical Procedure Code #3 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET ABMR(70,190)=$PIECE(ABM("SC",4),U)
+4 SET ABMR(70,190)=$$FMT^ABMERUTL(ABMR(70,190),7)
+5 QUIT
+6 ;
200 ;Other Surgical Procedure Date #3 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",4),"^",2)
+4 DO DFMT^ABMERUTL
+5 SET ABMR(70,200)=Y
+6 SET ABMR(70,200)=$$FMT^ABMERUTL(ABMR(70,200),6)
+7 QUIT
+8 ;
210 ;Other Surgical Procedure Code #4 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET ABMR(70,210)=$PIECE(ABM("SC",5),U)
+4 SET ABMR(70,210)=$$FMT^ABMERUTL(ABMR(70,210),7)
+5 QUIT
+6 ;
220 ;Other Surgical Procedure Date #4 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",5),"^",2)
+4 DO DFMT^ABMERUTL
+5 SET ABMR(70,220)=Y
+6 SET ABMR(70,220)=$$FMT^ABMERUTL(ABMR(70,220),6)
+7 QUIT
+8 ;
230 ;Other Surgical Procedure Code #5 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET ABMR(70,230)=$PIECE(ABM("SC",6),U)
+4 SET ABMR(70,230)=$$FMT^ABMERUTL(ABMR(70,230),7)
+5 QUIT
+6 ;
240 ;Other Surgical Procedure Date #5 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",6),"^",2)
+4 DO DFMT^ABMERUTL
+5 SET ABMR(70,240)=Y
+6 SET ABMR(70,240)=$$FMT^ABMERUTL(ABMR(70,240),6)
+7 QUIT
+8 ;
250 ;Admitting Diagnosis (SOURCE: FILE=9002274.4, FIELD=.59)
+1 ; form locator #76
+2 IF '$DATA(ABM(9002274.4,ABMP("BDFN"),.59))
DO DIQ1
+3 SET ABMR(70,250)=ABM(9002274.4,ABMP("BDFN"),.59,"E")
+4 SET ABMR(70,250)=$TRANSLATE(ABMR(70,250),".")
+5 ;S ABMR(70,250)=$$FMT^ABMERUTL(ABMR(70,250),6) ;abm*2.6*17 IHS/SD/SDR HEAT238640
+6 ;abm*2.6*17 IHS/SD/SDR HEAT238640
SET ABMR(70,250)=$$FMT^ABMERUTL(ABMR(70,250),7)
+7 QUIT
+8 ;
260 ;External Cause of Injury (SOURCE: FILE=9002274.4, FIELD=)
+1 ; form locator #77
+2 SET ABMR(70,260)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),"^",12)
+3 ;S ABMR(70,260)=$P($$DX^ABMCVAPI(+ABMR(70,260),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
+4 ;CSV-c ;abm*2.6*3 HEAT11931
IF (+ABMR(70,260))
SET ABMR(70,260)=$PIECE($$DX^ABMCVAPI(+ABMR(70,260),ABMP("VDT")),U,2)
+5 SET ABMR(70,260,"POA")=$$POA(ABMR(70,260))
+6 SET ABMR(70,260)=$TRANSLATE($GET(ABMR(70,260)),".")
+7 ;S ABMR(70,260)=$$FMT^ABMERUTL(ABMR(70,260),6) ;abm*2.6*17 IHS/SD/SDR HEAT238640
+8 ;abm*2.6*17 IHS/SD/SDR HEAT238640
SET ABMR(70,260)=$$FMT^ABMERUTL(ABMR(70,260),7)
+9 QUIT
+10 ;
270 ;Procedure Coding Method Used (SOURCE: FILE=9999999.18, FIELD=)
+1 ; form locator #79
+2 IF +$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,0))'=0
SET ABMR(70,270)=9
+3 IF '$TEST
SET ABMR(70,270)=$SELECT($PIECE($GET(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),U,2)="I":9,1:4)
+4 SET ABMR(70,270)=$$FMT^ABMERUTL(ABMR(70,270),"1N")
+5 QUIT
+6 ;
280 ;Filler
+1 SET ABMR(70,280)=""
+2 SET ABMR(70,280)=$$FMT^ABMERUTL(ABMR(70,280),23)
+3 QUIT
290 ;External Cause of Injury (2) (SOURCE: FILE=9002274.4, FIELD=)
+1 ; form locator #77
+2 SET ABMR(70,290)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,19)
+3 ;S ABMR(70,290)=$P($$DX^ABMCVAPI(+ABMR(70,290),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
+4 ;CSV-c ;abm*2.6*3 HEAT11931
IF (+ABMR(70,290))
SET ABMR(70,290)=$PIECE($$DX^ABMCVAPI(+ABMR(70,290),ABMP("VDT")),U,2)
+5 SET ABMR(70,290,"POA")=$$POA(ABMR(70,290))
+6 SET ABMR(70,290)=$TRANSLATE($GET(ABMR(70,290)),".")
+7 ;S ABMR(70,290)=$$FMT^ABMERUTL(ABMR(70,290),6) ;abm*2.6*17 IHS/SD/SDR HEAT238640
+8 ;abm*2.6*17 IHS/SD/SDR HEAT238640
SET ABMR(70,290)=$$FMT^ABMERUTL(ABMR(70,290),7)
+9 QUIT
300 ;External Cause of Injury (3) (SOURCE: FILE=9002274.4, FIELD=)
+1 ; form locator #77
+2 SET ABMR(70,300)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,20)
+3 ;S ABMR(70,300)=$P($$DX^ABMCVAPI(+ABMR(70,300),ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*3 HEAT11931
+4 ;CSV-c ;abm*2.6*3 HEAT11931
IF (+ABMR(70,300))
SET ABMR(70,300)=$PIECE($$DX^ABMCVAPI(+ABMR(70,300),ABMP("VDT")),U,2)
+5 SET ABMR(70,300,"POA")=$$POA(ABMR(70,300))
+6 SET ABMR(70,300)=$TRANSLATE($GET(ABMR(70,300)),".")
+7 ;S ABMR(70,300)=$$FMT^ABMERUTL(ABMR(70,300),6) ;abm*2.6*17 IHS/SD/SDR HEAT238640
+8 ;abm*2.6*17 IHS/SD/SDR HEAT238640
SET ABMR(70,300)=$$FMT^ABMERUTL(ABMR(70,300),7)
+9 QUIT
+10 ;
SCODE ;SURGICAL PROCEDURE CODES
+1 ; Quit if already done
IF $DATA(ABM("SC"))
QUIT
+2 NEW I
+3 SET I=0
SET CNT=0
+4 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,"C",I))
IF +I=0
QUIT
Begin DoDot:1
+5 SET J=0
+6 FOR
SET J=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,"C",I,J))
IF +J=0
QUIT
Begin DoDot:2
+7 SET CNT=CNT+1
+8 SET ABM("ZERO")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,J,0))
+9 ;CSV-c
SET ABM("SC",CNT)=$PIECE($$ICDOP^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$PIECE(ABM("ZERO"),U,3)
+10 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),U,5)'="E"
QUIT
+11 SET ABM("SC",CNT)=$TRANSLATE(ABM("SC",CNT),".")
End DoDot:2
End DoDot:1
+12 IF $DATA(ABM("SC"))
FOR I=1:1:6
IF '$DATA(ABM("SC",I))
SET ABM("SC",I)=""
+13 IF $DATA(ABM("SC"))
QUIT
+14 ; if procedure coding method used is ICD use node 19,
+15 ; else use node 21 (Med/Surg)
+16 SET ABM("SUB")=$SELECT($PIECE($GET(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),"^",2)="I":19,1:21)
+17 NEW I
+18 SET I=0
SET CNT=0
+19 ; loop INS priority order
+20 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),"C",I))
IF 'I
QUIT
Begin DoDot:1
+21 NEW J
+22 SET J=0
+23 ; Loop IEN to multiple
+24 FOR
SET J=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),"C",I,J))
IF 'J
QUIT
Begin DoDot:2
+25 ; increment counter
SET CNT=CNT+1
+26 SET ABM("ZERO")=^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),J,0)
+27 ; ICD procedure code ^ date of service
IF ABM("SUB")=19
Begin DoDot:3
+28 ;CSV-c
SET ABM("SC",CNT)=$PIECE($$ICDOP^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$PIECE(ABM("ZERO"),U,3)
+29 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"
QUIT
+30 SET ABM("SC",CNT)=$TRANSLATE(ABM("SC",CNT),".")
End DoDot:3
+31 ; CPT code ^ date/time
+32 ;CSV-c
IF ABM("SUB")=21
SET ABM("SC",CNT)=$PIECE($$CPT^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$PIECE(ABM("ZERO"),U,5)
End DoDot:2
End DoDot:1
+33 FOR I=1:1:6
IF '$DATA(ABM("SC",I))
SET ABM("SC",I)=""
+34 QUIT
+35 ;
DIQ1 ;GET INFO FROM FILE 9002274.4
+1 NEW I
+2 SET DA=ABMP("BDFN")
+3 SET DR=".59;.857"
+4 SET DIQ="ABM"
+5 SET DIQ(0)="E"
+6 SET DIC="^ABMDBILL(DUZ(2),"
+7 DO EN^DIQ1
+8 KILL DIQ
+9 QUIT
+10 ;
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
+1 ;
+2 ; INPUT: ABMX = data element
+3 ; Y = bill internal entry number
+4 ;
+5 ; OUTPUT: Y = bill internal entry number
+6 ;
+7 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+8 DO @ABMX
+9 SET Y=ABMR(70,ABMX)
+10 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+11 KILL ABMR(70,ABMX),ABMX,ABMY
+12 QUIT Y
POA(ABMDX) ;EP
+1 NEW I
+2 SET I=0
+3 SET ABMRPOA=""
+4 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I))
IF 'I
QUIT
Begin DoDot:1
+5 IF ABMDX=$PIECE($GET(^ICD9($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I,0)),U),0)),U)
SET ABMRPOA=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I,0)),U,5)
End DoDot:1
+6 QUIT ABMRPOA
