ABME570 ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 70-1 (Medical) ;
;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
;Original;DMJ;08/18/95 10:07 AM
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
;
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 ^ABME570A
F I=130:10:280 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, 79-85 (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, 86-93 (SOURCE: FILE=9002274.4 FIELD=)
; form locator #80
D SCODE
S Y=$P(ABM("SC",1),"^",2)
S ABMR(70,140)=$$Y2KD2^ABMDUTL(Y)
S ABMR(70,140)=$$FMT^ABMERUTL(ABMR(70,140),8)
Q
;
150 ;Other Surgical Procedure Code #1, 94-100 (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, 101-108 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",2),"^",2)
S ABMR(70,160)=$$Y2KD2^ABMDUTL(Y)
S ABMR(70,160)=$$FMT^ABMERUTL(ABMR(70,160),8)
Q
;
170 ;Other Surgical Procedure Code #2, 109-115 (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, 116-123 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",3),"^",2)
S ABMR(70,180)=$$Y2KD2^ABMDUTL(Y)
S ABMR(70,180)=$$FMT^ABMERUTL(ABMR(70,180),8)
Q
;
190 ;Other Surgical Procedure Code #3, 124-130 (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, 131-138 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",4),"^",2)
S ABMR(70,200)=$$Y2KD2^ABMDUTL(Y)
S ABMR(70,200)=$$FMT^ABMERUTL(ABMR(70,200),8)
Q
;
210 ;Other Surgical Procedure Code #4, 139-145 (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, 146-153 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",5),"^",2)
S ABMR(70,220)=$$Y2KD2^ABMDUTL(Y)
S ABMR(70,220)=$$FMT^ABMERUTL(ABMR(70,220),8)
Q
;
230 ;Other Surgical Procedure Code #5, 154-160 (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, 161-168 (SOURCE: FILE=9002274.4)
; form locator #81
D SCODE
S Y=$P(ABM("SC",6),"^",2)
S ABMR(70,240)=$$Y2KD2^ABMDUTL(Y)
S ABMR(70,240)=$$FMT^ABMERUTL(ABMR(70,240),8)
Q
;
250 ;Admitting Diagnosis, 169-174 (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)
Q
;
260 ;External Cause of Injury, 175-180 (SOURCE: FILE=9002274.4, FIELD=)
; form locator #77
N I
S I=0
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I)) Q:'I D
.Q:$D(ABMR(70,260))
.;I $E($P($$DX^ABMCVAPI(I,ABMP("VDT")),U,2))="E" S ABMR(70,260)=$P($$DX^ABMCVAPI(I,ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*14 updated API call
.I $E($P($$DX^ABMCVAPI(+I,ABMP("VDT")),U,2))="E" S ABMR(70,260)=$P($$DX^ABMCVAPI(+I,ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*14 updated API call
S ABMR(70,260)=$TR($G(ABMR(70,260)),".")
S ABMR(70,260)=$$FMT^ABMERUTL(ABMR(70,260),6)
Q
;
270 ;Procedure Coding Method Used, 181-181 (SOURCE: FILE=9999999.18, FIELD=)
; form locator #79
S ABMR(70,270)=$S($P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),"^",2)="I":9,1:4)
S ABMR(70,270)=$$FMT^ABMERUTL(ABMR(70,270),"1N")
Q
;
280 ;Filler (National Use), 182-192
S ABMR(70,280)=""
S ABMR(70,280)=$$FMT^ABMERUTL(ABMR(70,280),11)
Q
;
SCODE ;SURGICAL PROCEDURE CODES
Q:$D(ABM("SC")) ; Quit if already done
; 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
ABME570 ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 70-1 (Medical) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
+2 ;Original;DMJ;08/18/95 10:07 AM
+3 ;
+4 ; IHS/SD/SDR - v2.6 CSV
+5 ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
+6 ;
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 ^ABME570A
+2 FOR I=130:10:280
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, 79-85 (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, 86-93 (SOURCE: FILE=9002274.4 FIELD=)
+1 ; form locator #80
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",1),"^",2)
+4 SET ABMR(70,140)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(70,140)=$$FMT^ABMERUTL(ABMR(70,140),8)
+6 QUIT
+7 ;
150 ;Other Surgical Procedure Code #1, 94-100 (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, 101-108 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",2),"^",2)
+4 SET ABMR(70,160)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(70,160)=$$FMT^ABMERUTL(ABMR(70,160),8)
+6 QUIT
+7 ;
170 ;Other Surgical Procedure Code #2, 109-115 (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, 116-123 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",3),"^",2)
+4 SET ABMR(70,180)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(70,180)=$$FMT^ABMERUTL(ABMR(70,180),8)
+6 QUIT
+7 ;
190 ;Other Surgical Procedure Code #3, 124-130 (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, 131-138 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",4),"^",2)
+4 SET ABMR(70,200)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(70,200)=$$FMT^ABMERUTL(ABMR(70,200),8)
+6 QUIT
+7 ;
210 ;Other Surgical Procedure Code #4, 139-145 (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, 146-153 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",5),"^",2)
+4 SET ABMR(70,220)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(70,220)=$$FMT^ABMERUTL(ABMR(70,220),8)
+6 QUIT
+7 ;
230 ;Other Surgical Procedure Code #5, 154-160 (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, 161-168 (SOURCE: FILE=9002274.4)
+1 ; form locator #81
+2 DO SCODE
+3 SET Y=$PIECE(ABM("SC",6),"^",2)
+4 SET ABMR(70,240)=$$Y2KD2^ABMDUTL(Y)
+5 SET ABMR(70,240)=$$FMT^ABMERUTL(ABMR(70,240),8)
+6 QUIT
+7 ;
250 ;Admitting Diagnosis, 169-174 (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 SET ABMR(70,250)=$$FMT^ABMERUTL(ABMR(70,250),6)
+6 QUIT
+7 ;
260 ;External Cause of Injury, 175-180 (SOURCE: FILE=9002274.4, FIELD=)
+1 ; form locator #77
+2 NEW I
+3 SET I=0
+4 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I))
IF 'I
QUIT
Begin DoDot:1
+5 IF $DATA(ABMR(70,260))
QUIT
+6 ;I $E($P($$DX^ABMCVAPI(I,ABMP("VDT")),U,2))="E" S ABMR(70,260)=$P($$DX^ABMCVAPI(I,ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*14 updated API call
+7 ;CSV-c ;abm*2.6*14 updated API call
IF $EXTRACT($PIECE($$DX^ABMCVAPI(+I,ABMP("VDT")),U,2))="E"
SET ABMR(70,260)=$PIECE($$DX^ABMCVAPI(+I,ABMP("VDT")),U,2)
End DoDot:1
+8 SET ABMR(70,260)=$TRANSLATE($GET(ABMR(70,260)),".")
+9 SET ABMR(70,260)=$$FMT^ABMERUTL(ABMR(70,260),6)
+10 QUIT
+11 ;
270 ;Procedure Coding Method Used, 181-181 (SOURCE: FILE=9999999.18, FIELD=)
+1 ; form locator #79
+2 SET ABMR(70,270)=$SELECT($PIECE($GET(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),"^",2)="I":9,1:4)
+3 SET ABMR(70,270)=$$FMT^ABMERUTL(ABMR(70,270),"1N")
+4 QUIT
+5 ;
280 ;Filler (National Use), 182-192
+1 SET ABMR(70,280)=""
+2 SET ABMR(70,280)=$$FMT^ABMERUTL(ABMR(70,280),11)
+3 QUIT
+4 ;
SCODE ;SURGICAL PROCEDURE CODES
+1 ; Quit if already done
IF $DATA(ABM("SC"))
QUIT
+2 ; if procedure coding method used is ICD use node 19,
+3 ; else use node 21 (Med/Surg)
+4 SET ABM("SUB")=$SELECT($PIECE($GET(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),"^",2)="I":19,1:21)
+5 NEW I
+6 SET I=0
SET CNT=0
+7 ; loop INS priority order
+8 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),"C",I))
IF 'I
QUIT
Begin DoDot:1
+9 NEW J
+10 SET J=0
+11 ; Loop IEN to multiple
+12 FOR
SET J=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),"C",I,J))
IF 'J
QUIT
Begin DoDot:2
+13 ; increment counter
SET CNT=CNT+1
+14 SET ABM("ZERO")=^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),J,0)
+15 ; ICD procedure code ^ date of service
IF ABM("SUB")=19
Begin DoDot:3
+16 ;CSV-c
SET ABM("SC",CNT)=$PIECE($$ICDOP^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$PIECE(ABM("ZERO"),U,3)
+17 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"
QUIT
+18 SET ABM("SC",CNT)=$TRANSLATE(ABM("SC",CNT),".")
End DoDot:3
+19 ; CPT code ^ date/time
+20 ;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
+21 FOR I=1:1:6
IF '$DATA(ABM("SC",I))
SET ABM("SC",I)=""
+22 QUIT
+23 ;
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
