ABMER80 ; IHS/ASDST/DMJ - UB92 EMC RECORD 80 (PHYSICIAN DATA) ;
;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
;Original;DMJ;08/18/95 10:09 AM
;
; IHS/ASDS/SDH - 04/26/01 - V2.4 Patch 9 - NOIS NCA-1100-180025
; Insert leading 00 before providers for AHCCCS
; IHS/ASDS/DMJ - 12/04/01 - V2.4 Patch 10 - NOIS HQW-1201-100015
; Sequence 80 record w/o skipping numbers
;
; IHS/SD/LSL - 09/05/02 0 v2.5 Patch 2
; Added Kidscare check when getting provider numbers.
;
;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check from 'equals' to 'contains'
; *********************************************************************
;
START ;START HERE
K ABMR(80),ABMREC(80)
S ABME("RTYPE")=80
D SET^ABMERUTL
F ABME("S#")=1:1:3 D
.Q:'$D(ABMP("INS",ABME("S#")))
.;I $$RCID^ABMERUTL(ABMP("INS"))=61044,ABME("S#")>1 Q ;abm*2.6*21 IHS/SD/SDR HEAT123457
.I $$RCID^ABMERUTL(ABMP("INS"))["61044",ABME("S#")>1 Q ;abm*2.6*21 IHS/SD/SDR HEAT123457
.S ABME("NTYPE")=$S($P(ABMP("INS",ABME("S#")),"^",2)="D":"D",$P(ABMP("INS",ABME("S#")),"^",2)="R":"R",1:"P")
.I $$RCID^ABMERUTL(ABMP("INS"))=99999,ABME("NTYPE")'="D" Q
.S ABME("NTYPE",ABME("NTYPE"))=""
.D LOOP
.D S90^ABMERUTL
K ABM,ABME
Q
LOOP ;LOOP HERE
F I=10:10:130 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),80,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(80,ABME("S#"))=$G(ABMREC(80,ABME("S#")))_ABMR(80,I)
Q
10 ;Record type
S ABMR(80,10)=80
Q
20 ;Sequence
S ABMR(80,20)=ABME("S#")
S:$$RCID^ABMERUTL(ABMP("INS"))=99999 ABMR(80,20)=1
S ABMR(80,20)=$$FMT^ABMERUTL(ABMR(80,20),"2NR")
Q
30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
S ABMR(80,30)=$$EX^ABMER20(30,ABMP("BDFN"))
S ABMR(80,30)=$$FMT^ABMERUTL(ABMR(80,30),20)
Q
40 ;Physician Number Qualifying Codes (SOURCE: FILE=9002274.4041 FIELD=)
S ABMR(80,40)=$S(ABME("NTYPE")="D":"",ABME("NTYPE")="R":"UP",1:"SL")
S ABMR(80,40)=$$FMT^ABMERUTL(ABMR(80,40),2)
Q
50 ;Attending Physician Number (SOURCE: FILE=9002274.4041, FIELD=)
D GET41 S ABMR(80,50)=$P(ABM(41,1),U)
I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(80,50)="OO"_ABMR(80,50)
I $$ENVOY^ABMEF16 D
.S ABMR(80,50)=$$REPLNOT^ABMER10(ABMR(80,50),", ")
S ABMR(80,50)=$$FMT^ABMERUTL(ABMR(80,50),16)
Q
60 ;Operating or Other Physician Number (SOURCE: FILE=9002274.4041, FIELD=)
D GET41 S ABMR(80,60)=$P(ABM(41,2),U)
I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(80,60)="00"_ABMR(80,60)
S ABMR(80,60)=$$FMT^ABMERUTL(ABMR(80,60),16)
Q
70 ;Other Physician Number 1 (SOURCE: FILE=9002274.4041, FIELD=)
D GET41 S ABMR(80,70)=$P(ABM(41,3),U)
I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(80,70)="00"_ABMR(80,70)
S ABMR(80,70)=$$FMT^ABMERUTL(ABMR(80,70),16)
Q
80 ;Other Physician Number 2 (SOURCE: FILE=9002274.4041, FIELD=)
D GET41 S ABMR(80,80)=$P(ABM(41,4),U)
I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(80,80)="00"_ABMR(80,80)
S ABMR(80,80)=$$FMT^ABMERUTL(ABMR(80,80),16)
Q
90 ;Attending Physician Name (SOURCE: FILE=9002274.4041, FIELD=)
D GET41 S ABMR(80,90)=$P(ABM(41,1),"^",2)
S ABMR(80,90)=$$FMT^ABMERUTL(ABMR(80,90),25)
Q
100 ;Operating or Other Physician Name (SOURCE: FILE=9002274.4041, FIELD=)
D GET41 S ABMR(80,100)=$P(ABM(41,2),"^",2)
S ABMR(80,100)=$$FMT^ABMERUTL(ABMR(80,100),25)
Q
110 ;Other Physician Name 1 (SOURCE: FILE=9002274.4017, FIELD=.01)
D GET41 S ABMR(80,110)=$P(ABM(41,3),"^",2)
S ABMR(80,110)=$$FMT^ABMERUTL(ABMR(80,110),25)
Q
120 ;Other Physician Name 2 (SOURCE: FILE=9002274.4017, FIELD=.01)
D GET41 S ABMR(80,120)=$P(ABM(41,4),"^",2)
S ABMR(80,120)=$$FMT^ABMERUTL(ABMR(80,120),25)
Q
130 ;Filler
S ABMR(80,130)=""
S ABMR(80,130)=$$FMT^ABMERUTL(ABMR(80,130),2)
Q
GET41 ;EP - get provider information
Q:$D(ABM(41))
S CNT=1
N I S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0)),DA=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,+I,0)),U) I 'DA S ABM(41,1)=""
D:DA GP
S CNT=2
S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0)),DA=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,+I,0)),U)
I DA D GP
S I=0 F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",I)) Q:'I!(CNT>3) D
.S DA=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,I,0),U)
.S CNT=CNT+1 D GP
F I=1:1:4 I '$D(ABM(41,I)) S ABM(41,I)=""
Q
GP ;GIVEN DA GET PROVIDER NAME AND NUMBER
D DIQ1
S ABM("LNAME")=$P(ABM(200,DA,.01,"E")," ",1)
S ABM("FNAME")=$P(ABM("LNAME"),",",2),ABM("LNAME")=$P(ABM("LNAME"),",",1)
S ABM("LNAME")=ABM("LNAME")_ABMP("SPACES"),ABM("LNAME")=$E(ABM("LNAME"),1,16)
S ABM("FNAME")=ABM("FNAME")_ABMP("SPACES"),ABM("FNAME")=$E(ABM("FNAME"),1,8)
S ABM("MI")=$P(ABM(200,DA,.01,"E"),",",2),ABM("MI")=$P(ABM("MI")," ",2),ABM("MI")=$E(ABM("MI")) I ABM("MI")="" S ABM("MI")=" "
S ABM("P#")=$P($G(^VA(200,DA,9999999.18,ABMP("INS"),0)),"^",2)
I ABM("P#")="" D
.S:(ABME("NTYPE")="D"!(ABME("NTYPE")="K")) ABM("P#")=ABM(200,DA,9999999.07,"E")
.I ABME("NTYPE")="R" D
..S ABM("P#")=ABM(200,DA,9999999.08,"E")
..S:ABM("P#")="" ABM("P#")="PHS000"
.I ABME("NTYPE")="P" D
..S ABM("LSTATE")=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",23)
..S:ABM("LSTATE")="" ABM("LSTATE")=$P(^AUTTLOC(+ABMP("LDFN"),0),"^",14)
..S ABM("P#")=$$SLN^ABMERUTL(DA,ABM("LSTATE"))
S ABM(41,CNT)=ABM("P#")_"^"_ABM("LNAME")_ABM("FNAME")_ABM("MI")
Q
DIQ1 ;GET PROVIDER INFO
N I S DR=".01;9999999.07;9999999.08",DIQ="ABM",DIQ(0)="E",DIC="^VA(200," D EN^DIQ1 K DIQ
S:ABM(200,DA,9999999.08,"E")="" ABM(200,DA,9999999.08,"E")="PHS000"
Q
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
;X=data element, Y=bill internal entry number
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(80,ABMX)
I $D(ABMP("FMT")) S ABMP("FMT")=1
K ABMR(80,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
Q Y
ABMER80 ; IHS/ASDST/DMJ - UB92 EMC RECORD 80 (PHYSICIAN DATA) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
+2 ;Original;DMJ;08/18/95 10:09 AM
+3 ;
+4 ; IHS/ASDS/SDH - 04/26/01 - V2.4 Patch 9 - NOIS NCA-1100-180025
+5 ; Insert leading 00 before providers for AHCCCS
+6 ; IHS/ASDS/DMJ - 12/04/01 - V2.4 Patch 10 - NOIS HQW-1201-100015
+7 ; Sequence 80 record w/o skipping numbers
+8 ;
+9 ; IHS/SD/LSL - 09/05/02 0 v2.5 Patch 2
+10 ; Added Kidscare check when getting provider numbers.
+11 ;
+12 ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check from 'equals' to 'contains'
+13 ; *********************************************************************
+14 ;
START ;START HERE
+1 KILL ABMR(80),ABMREC(80)
+2 SET ABME("RTYPE")=80
+3 DO SET^ABMERUTL
+4 FOR ABME("S#")=1:1:3
Begin DoDot:1
+5 IF '$DATA(ABMP("INS",ABME("S#")))
QUIT
+6 ;I $$RCID^ABMERUTL(ABMP("INS"))=61044,ABME("S#")>1 Q ;abm*2.6*21 IHS/SD/SDR HEAT123457
+7 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))["61044"
IF ABME("S#")>1
QUIT
+8 SET ABME("NTYPE")=$SELECT($PIECE(ABMP("INS",ABME("S#")),"^",2)="D":"D",$PIECE(ABMP("INS",ABME("S#")),"^",2)="R":"R",1:"P")
+9 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
IF ABME("NTYPE")'="D"
QUIT
+10 SET ABME("NTYPE",ABME("NTYPE"))=""
+11 DO LOOP
+12 DO S90^ABMERUTL
End DoDot:1
+13 KILL ABM,ABME
+14 QUIT
LOOP ;LOOP HERE
+1 FOR I=10:10:130
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),80,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(80,ABME("S#"))=$GET(ABMREC(80,ABME("S#")))_ABMR(80,I)
End DoDot:1
+5 QUIT
10 ;Record type
+1 SET ABMR(80,10)=80
+2 QUIT
20 ;Sequence
+1 SET ABMR(80,20)=ABME("S#")
+2 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
SET ABMR(80,20)=1
+3 SET ABMR(80,20)=$$FMT^ABMERUTL(ABMR(80,20),"2NR")
+4 QUIT
30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
+1 SET ABMR(80,30)=$$EX^ABMER20(30,ABMP("BDFN"))
+2 SET ABMR(80,30)=$$FMT^ABMERUTL(ABMR(80,30),20)
+3 QUIT
40 ;Physician Number Qualifying Codes (SOURCE: FILE=9002274.4041 FIELD=)
+1 SET ABMR(80,40)=$SELECT(ABME("NTYPE")="D":"",ABME("NTYPE")="R":"UP",1:"SL")
+2 SET ABMR(80,40)=$$FMT^ABMERUTL(ABMR(80,40),2)
+3 QUIT
50 ;Attending Physician Number (SOURCE: FILE=9002274.4041, FIELD=)
+1 DO GET41
SET ABMR(80,50)=$PIECE(ABM(41,1),U)
+2 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
SET ABMR(80,50)="OO"_ABMR(80,50)
+3 IF $$ENVOY^ABMEF16
Begin DoDot:1
+4 SET ABMR(80,50)=$$REPLNOT^ABMER10(ABMR(80,50),", ")
End DoDot:1
+5 SET ABMR(80,50)=$$FMT^ABMERUTL(ABMR(80,50),16)
+6 QUIT
60 ;Operating or Other Physician Number (SOURCE: FILE=9002274.4041, FIELD=)
+1 DO GET41
SET ABMR(80,60)=$PIECE(ABM(41,2),U)
+2 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
SET ABMR(80,60)="00"_ABMR(80,60)
+3 SET ABMR(80,60)=$$FMT^ABMERUTL(ABMR(80,60),16)
+4 QUIT
70 ;Other Physician Number 1 (SOURCE: FILE=9002274.4041, FIELD=)
+1 DO GET41
SET ABMR(80,70)=$PIECE(ABM(41,3),U)
+2 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
SET ABMR(80,70)="00"_ABMR(80,70)
+3 SET ABMR(80,70)=$$FMT^ABMERUTL(ABMR(80,70),16)
+4 QUIT
80 ;Other Physician Number 2 (SOURCE: FILE=9002274.4041, FIELD=)
+1 DO GET41
SET ABMR(80,80)=$PIECE(ABM(41,4),U)
+2 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
SET ABMR(80,80)="00"_ABMR(80,80)
+3 SET ABMR(80,80)=$$FMT^ABMERUTL(ABMR(80,80),16)
+4 QUIT
90 ;Attending Physician Name (SOURCE: FILE=9002274.4041, FIELD=)
+1 DO GET41
SET ABMR(80,90)=$PIECE(ABM(41,1),"^",2)
+2 SET ABMR(80,90)=$$FMT^ABMERUTL(ABMR(80,90),25)
+3 QUIT
100 ;Operating or Other Physician Name (SOURCE: FILE=9002274.4041, FIELD=)
+1 DO GET41
SET ABMR(80,100)=$PIECE(ABM(41,2),"^",2)
+2 SET ABMR(80,100)=$$FMT^ABMERUTL(ABMR(80,100),25)
+3 QUIT
110 ;Other Physician Name 1 (SOURCE: FILE=9002274.4017, FIELD=.01)
+1 DO GET41
SET ABMR(80,110)=$PIECE(ABM(41,3),"^",2)
+2 SET ABMR(80,110)=$$FMT^ABMERUTL(ABMR(80,110),25)
+3 QUIT
120 ;Other Physician Name 2 (SOURCE: FILE=9002274.4017, FIELD=.01)
+1 DO GET41
SET ABMR(80,120)=$PIECE(ABM(41,4),"^",2)
+2 SET ABMR(80,120)=$$FMT^ABMERUTL(ABMR(80,120),25)
+3 QUIT
130 ;Filler
+1 SET ABMR(80,130)=""
+2 SET ABMR(80,130)=$$FMT^ABMERUTL(ABMR(80,130),2)
+3 QUIT
GET41 ;EP - get provider information
+1 IF $DATA(ABM(41))
QUIT
+2 SET CNT=1
+3 NEW I
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
SET DA=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,+I,0)),U)
IF 'DA
SET ABM(41,1)=""
+4 IF DA
DO GP
+5 SET CNT=2
+6 SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0))
SET DA=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,+I,0)),U)
+7 IF DA
DO GP
+8 SET I=0
FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",I))
IF 'I!(CNT>3)
QUIT
Begin DoDot:1
+9 SET DA=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,I,0),U)
+10 SET CNT=CNT+1
DO GP
End DoDot:1
+11 FOR I=1:1:4
IF '$DATA(ABM(41,I))
SET ABM(41,I)=""
+12 QUIT
GP ;GIVEN DA GET PROVIDER NAME AND NUMBER
+1 DO DIQ1
+2 SET ABM("LNAME")=$PIECE(ABM(200,DA,.01,"E")," ",1)
+3 SET ABM("FNAME")=$PIECE(ABM("LNAME"),",",2)
SET ABM("LNAME")=$PIECE(ABM("LNAME"),",",1)
+4 SET ABM("LNAME")=ABM("LNAME")_ABMP("SPACES")
SET ABM("LNAME")=$EXTRACT(ABM("LNAME"),1,16)
+5 SET ABM("FNAME")=ABM("FNAME")_ABMP("SPACES")
SET ABM("FNAME")=$EXTRACT(ABM("FNAME"),1,8)
+6 SET ABM("MI")=$PIECE(ABM(200,DA,.01,"E"),",",2)
SET ABM("MI")=$PIECE(ABM("MI")," ",2)
SET ABM("MI")=$EXTRACT(ABM("MI"))
IF ABM("MI")=""
SET ABM("MI")=" "
+7 SET ABM("P#")=$PIECE($GET(^VA(200,DA,9999999.18,ABMP("INS"),0)),"^",2)
+8 IF ABM("P#")=""
Begin DoDot:1
+9 IF (ABME("NTYPE")="D"!(ABME("NTYPE")="K"))
SET ABM("P#")=ABM(200,DA,9999999.07,"E")
+10 IF ABME("NTYPE")="R"
Begin DoDot:2
+11 SET ABM("P#")=ABM(200,DA,9999999.08,"E")
+12 IF ABM("P#")=""
SET ABM("P#")="PHS000"
End DoDot:2
+13 IF ABME("NTYPE")="P"
Begin DoDot:2
+14 SET ABM("LSTATE")=$PIECE($GET(^AUTTLOC(+ABMP("LDFN"),0)),"^",23)
+15 IF ABM("LSTATE")=""
SET ABM("LSTATE")=$PIECE(^AUTTLOC(+ABMP("LDFN"),0),"^",14)
+16 SET ABM("P#")=$$SLN^ABMERUTL(DA,ABM("LSTATE"))
End DoDot:2
End DoDot:1
+17 SET ABM(41,CNT)=ABM("P#")_"^"_ABM("LNAME")_ABM("FNAME")_ABM("MI")
+18 QUIT
DIQ1 ;GET PROVIDER INFO
+1 NEW I
SET DR=".01;9999999.07;9999999.08"
SET DIQ="ABM"
SET DIQ(0)="E"
SET DIC="^VA(200,"
DO EN^DIQ1
KILL DIQ
+2 IF ABM(200,DA,9999999.08,"E")=""
SET ABM(200,DA,9999999.08,"E")="PHS000"
+3 QUIT
EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
+1 ;X=data element, Y=bill internal entry number
+2 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+3 DO @ABMX
+4 SET Y=ABMR(80,ABMX)
+5 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+6 KILL ABMR(80,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
+7 QUIT Y
