ABMUTL8A ; IHS/ASDST/DMJ - 837 UTILITIES ;
;;2.6;IHS Third Party Billing;**1,4,6,8,9,10,11,13,14**;NOV 12, 2009;Build 238
;
PXSET(X) ;EP - set px array
;x=bill ien
K ABMPX
K ABMICD
N I,J
S ABMCNT=0
S I=0
F S I=$O(^ABMDBILL(DUZ(2),X,19,"C",I)) Q:'I D
.S J=0
.F S J=$O(^ABMDBILL(DUZ(2),X,19,"C",I,J)) Q:'J D
..S ABMCNT=ABMCNT+1
..;start old abm*2.6*14 ICD10 002H
..;S:ABMCNT=1 ABMPX(ABMCNT)="BR"
..;S:ABMCNT'=1 ABMPX(ABMCNT)="BQ"
..;end old start new 002H
..S:ABMCNT=1 ABMPX(ABMCNT)=$S($P($G(^ABMDBILL(DUZ(2),X,19,J,0)),U,6)=1:"BBR",1:"BR")
..S:ABMCNT'=1 ABMPX(ABMCNT)=$S($P($G(^ABMDBILL(DUZ(2),X,19,J,0)),U,6)=1:"BBQ",1:"BQ")
..;end new 002H
..S ABMICD=$P($G(^ABMDBILL(DUZ(2),X,19,J,0)),U)
..S $P(ABMPX(ABMCNT),":",2)=$TR($P($$ICDOP^ABMCVAPI(+ABMICD,ABMP("VDT")),U,2),".") ;CSV-c
..S $P(ABMPX(ABMCNT),":",3)="D8"
..S $P(ABMPX(ABMCNT),":",4)=$$Y2KD2^ABMDUTL($P(^ABMDBILL(DUZ(2),X,19,J,0),U,3))
S I=0
;start old abm*2.6*1 HEAT2836
;F S I=$O(^ABMDBILL(DUZ(2),X,21,"C",I)) Q:'I D
;.S J=0
;.F S J=$O(^ABMDBILL(DUZ(2),X,21,"C",I,J)) Q:'J D
;..N ABMCODE
;..S ABMCODE=$P($G(^ABMDBILL(DUZ(2),X,21,J,0)),U)
;..S ABMCNT=ABMCNT+1
;..S:ABMCNT=1 ABMPX(ABMCNT)="BP"
;..S:ABMCNT'=1 ABMPX(ABMCNT)="BO"
;..S $P(ABMPX(ABMCNT),":",2)=$P($$CPT^ABMCVAPI(+ABMCODE,ABMP("VDT")),U,2) ;CSV-c
;..S $P(ABMPX(ABMCNT),":",3)="D8"
;..S $P(ABMPX(ABMCNT),":",4)=$$Y2KD2^ABMDUTL($P(^ABMDBILL(DUZ(2),X,21,J,0),U,5))
;end old HEAT2836
Q
OSSET(X) ;EP - occurrence span set
;x=bill ien
K ABMOS
S ABMCNT=0
N I
S I=0
F S I=$O(^ABMDBILL(DUZ(2),X,57,I)) Q:'I D
.S ABMLINE=^ABMDBILL(DUZ(2),X,57,I,0)
.S ABMCNT=ABMCNT+1
.S ABMOS(ABMCNT)="BI"
.S $P(ABMOS(ABMCNT),":",2)=$P($G(^ABMDCODE(+$P(ABMLINE,U),0)),U)
.S $P(ABMOS(ABMCNT),":",3)="RD8"
.S $P(ABMOS(ABMCNT),":",4)=$$Y2KD2^ABMDUTL($P(ABMLINE,"^",2))_"-"_$$Y2KD2^ABMDUTL($P(ABMLINE,"^",3))
Q
OCSET(X) ;EP - occurrence set
;x=bill ien
K ABMOC
S ABMCNT=0
N I
S I=0
F S I=$O(^ABMDBILL(DUZ(2),X,51,I)) Q:'I D
.S ABMLINE=^ABMDBILL(DUZ(2),X,51,I,0)
.S ABMCNT=ABMCNT+1
.S ABMOC(ABMCNT)="BH"
.S $P(ABMOC(ABMCNT),":",2)=$P($G(^ABMDCODE(+$P(ABMLINE,U),0)),U)
.S $P(ABMOC(ABMCNT),":",3)="D8"
.S $P(ABMOC(ABMCNT),":",4)=$$Y2KD2^ABMDUTL($P(ABMLINE,"^",2))
Q
CDSET(X) ;EP - condition code set
;x=bill ien
K ABMCD
S ABMCNT=0
N I
S I=0
F S I=$O(^ABMDBILL(DUZ(2),X,53,I)) Q:'I D
.S ABMLINE=^ABMDBILL(DUZ(2),X,53,I,0)
.S ABMCNT=ABMCNT+1
.S ABMCD(ABMCNT)="BG"
.S $P(ABMCD(ABMCNT),":",2)=$P($G(^ABMDCODE(+ABMLINE,0)),U)
Q
ANES(X) ;EP - anesthesia charges set
K ABMANES
S ABMCNT=0
N I
S I=0
F S I=$O(^ABMDBILL(DUZ(2),X,39,I)) Q:'I D Q:ABMCNT=2
.S ABMCNT=ABMCNT+1
.S ABMANES(ABMCNT)=$S(ABMCNT=1:"BP",1:"BO")
.S $P(ABMANES(ABMCNT),":",2)=$$GET1^DIQ(81,$P($G(^ABMDBILL(DUZ(2),X,39,I,0)),U),".01")
Q
ABMUTL8A ; IHS/ASDST/DMJ - 837 UTILITIES ;
+1 ;;2.6;IHS Third Party Billing;**1,4,6,8,9,10,11,13,14**;NOV 12, 2009;Build 238
+2 ;
PXSET(X) ;EP - set px array
+1 ;x=bill ien
+2 KILL ABMPX
+3 KILL ABMICD
+4 NEW I,J
+5 SET ABMCNT=0
+6 SET I=0
+7 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),X,19,"C",I))
IF 'I
QUIT
Begin DoDot:1
+8 SET J=0
+9 FOR
SET J=$ORDER(^ABMDBILL(DUZ(2),X,19,"C",I,J))
IF 'J
QUIT
Begin DoDot:2
+10 SET ABMCNT=ABMCNT+1
+11 ;start old abm*2.6*14 ICD10 002H
+12 ;S:ABMCNT=1 ABMPX(ABMCNT)="BR"
+13 ;S:ABMCNT'=1 ABMPX(ABMCNT)="BQ"
+14 ;end old start new 002H
+15 IF ABMCNT=1
SET ABMPX(ABMCNT)=$SELECT($PIECE($GET(^ABMDBILL(DUZ(2),X,19,J,0)),U,6)=1:"BBR",1:"BR")
+16 IF ABMCNT'=1
SET ABMPX(ABMCNT)=$SELECT($PIECE($GET(^ABMDBILL(DUZ(2),X,19,J,0)),U,6)=1:"BBQ",1:"BQ")
+17 ;end new 002H
+18 SET ABMICD=$PIECE($GET(^ABMDBILL(DUZ(2),X,19,J,0)),U)
+19 ;CSV-c
SET $PIECE(ABMPX(ABMCNT),":",2)=$TRANSLATE($PIECE($$ICDOP^ABMCVAPI(+ABMICD,ABMP("VDT")),U,2),".")
+20 SET $PIECE(ABMPX(ABMCNT),":",3)="D8"
+21 SET $PIECE(ABMPX(ABMCNT),":",4)=$$Y2KD2^ABMDUTL($PIECE(^ABMDBILL(DUZ(2),X,19,J,0),U,3))
End DoDot:2
End DoDot:1
+22 SET I=0
+23 ;start old abm*2.6*1 HEAT2836
+24 ;F S I=$O(^ABMDBILL(DUZ(2),X,21,"C",I)) Q:'I D
+25 ;.S J=0
+26 ;.F S J=$O(^ABMDBILL(DUZ(2),X,21,"C",I,J)) Q:'J D
+27 ;..N ABMCODE
+28 ;..S ABMCODE=$P($G(^ABMDBILL(DUZ(2),X,21,J,0)),U)
+29 ;..S ABMCNT=ABMCNT+1
+30 ;..S:ABMCNT=1 ABMPX(ABMCNT)="BP"
+31 ;..S:ABMCNT'=1 ABMPX(ABMCNT)="BO"
+32 ;..S $P(ABMPX(ABMCNT),":",2)=$P($$CPT^ABMCVAPI(+ABMCODE,ABMP("VDT")),U,2) ;CSV-c
+33 ;..S $P(ABMPX(ABMCNT),":",3)="D8"
+34 ;..S $P(ABMPX(ABMCNT),":",4)=$$Y2KD2^ABMDUTL($P(^ABMDBILL(DUZ(2),X,21,J,0),U,5))
+35 ;end old HEAT2836
+36 QUIT
OSSET(X) ;EP - occurrence span set
+1 ;x=bill ien
+2 KILL ABMOS
+3 SET ABMCNT=0
+4 NEW I
+5 SET I=0
+6 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),X,57,I))
IF 'I
QUIT
Begin DoDot:1
+7 SET ABMLINE=^ABMDBILL(DUZ(2),X,57,I,0)
+8 SET ABMCNT=ABMCNT+1
+9 SET ABMOS(ABMCNT)="BI"
+10 SET $PIECE(ABMOS(ABMCNT),":",2)=$PIECE($GET(^ABMDCODE(+$PIECE(ABMLINE,U),0)),U)
+11 SET $PIECE(ABMOS(ABMCNT),":",3)="RD8"
+12 SET $PIECE(ABMOS(ABMCNT),":",4)=$$Y2KD2^ABMDUTL($PIECE(ABMLINE,"^",2))_"-"_$$Y2KD2^ABMDUTL($PIECE(ABMLINE,"^",3))
End DoDot:1
+13 QUIT
OCSET(X) ;EP - occurrence set
+1 ;x=bill ien
+2 KILL ABMOC
+3 SET ABMCNT=0
+4 NEW I
+5 SET I=0
+6 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),X,51,I))
IF 'I
QUIT
Begin DoDot:1
+7 SET ABMLINE=^ABMDBILL(DUZ(2),X,51,I,0)
+8 SET ABMCNT=ABMCNT+1
+9 SET ABMOC(ABMCNT)="BH"
+10 SET $PIECE(ABMOC(ABMCNT),":",2)=$PIECE($GET(^ABMDCODE(+$PIECE(ABMLINE,U),0)),U)
+11 SET $PIECE(ABMOC(ABMCNT),":",3)="D8"
+12 SET $PIECE(ABMOC(ABMCNT),":",4)=$$Y2KD2^ABMDUTL($PIECE(ABMLINE,"^",2))
End DoDot:1
+13 QUIT
CDSET(X) ;EP - condition code set
+1 ;x=bill ien
+2 KILL ABMCD
+3 SET ABMCNT=0
+4 NEW I
+5 SET I=0
+6 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),X,53,I))
IF 'I
QUIT
Begin DoDot:1
+7 SET ABMLINE=^ABMDBILL(DUZ(2),X,53,I,0)
+8 SET ABMCNT=ABMCNT+1
+9 SET ABMCD(ABMCNT)="BG"
+10 SET $PIECE(ABMCD(ABMCNT),":",2)=$PIECE($GET(^ABMDCODE(+ABMLINE,0)),U)
End DoDot:1
+11 QUIT
ANES(X) ;EP - anesthesia charges set
+1 KILL ABMANES
+2 SET ABMCNT=0
+3 NEW I
+4 SET I=0
+5 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),X,39,I))
IF 'I
QUIT
Begin DoDot:1
+6 SET ABMCNT=ABMCNT+1
+7 SET ABMANES(ABMCNT)=$SELECT(ABMCNT=1:"BP",1:"BO")
+8 SET $PIECE(ABMANES(ABMCNT),":",2)=$$GET1^DIQ(81,$PIECE($GET(^ABMDBILL(DUZ(2),X,39,I,0)),U),".01")
End DoDot:1
IF ABMCNT=2
QUIT
+9 QUIT
