Routine: ABME570A

ABME570A ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 70-1 (Medical) cont'd ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;DMJ;

 ; IHS/SD/SDR - v2.6 CSV

LOOP ;LOOP HERE

 F I=10:10:120 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)

10 ;Record type, 1-2

 S ABMR(70,10)=70

20 ;Sequence , 3-4

 S ABMR(70,20)="01"

30 ;Patient Control Number, 5-24 (SOURCE: FILE=9000001.41,FIELD=.02)

 S ABMR(70,30)=$$EX^ABMER20(30,ABMP("BDFN"))

 S ABMR(70,30)=$$FMT^ABMERUTL(ABMR(70,30),20)

40 ;Principle Diagnosis Code, 25-30 (SOURCE: FILE=9002274.4017 FIELD=.01)

 ; from locator #67

 D GET17

 S ABMR(70,40)=ABM(17,1)

 S ABMR(70,40)=$$FMT^ABMERUTL(ABMR(70,40),6)

50 ;Other Diagnosis Code #1, 31-36 (SOURCE: FILE=9002274.4017, FIELD=.01)

 ; from locator #68

 D GET17

 S ABMR(70,50)=ABM(17,2)

 S ABMR(70,50)=$$FMT^ABMERUTL(ABMR(70,50),6)

60 ;Other Diagnosis Code #2, 37-42 (SOURCE: FILE=9002274.4017, FIELD=.01)

 ; from locator #69

 D GET17

 S ABMR(70,60)=ABM(17,3)

 S ABMR(70,60)=$$FMT^ABMERUTL(ABMR(70,60),6)

70 ;Other Diagnosis Code #3, 43-48 (SOURCE: FILE=9002274.4017, FIELD=.01)

 ; from locator #70

 D GET17

 S ABMR(70,70)=ABM(17,4)

 S ABMR(70,70)=$$FMT^ABMERUTL(ABMR(70,70),6)

80 ;Other Diagnosis Code #4, 49-54 (SOURCE: FILE=9002274.4017, FIELD=.01)

 ; from locator #71

 D GET17

 S ABMR(70,80)=ABM(17,5)

 S ABMR(70,80)=$$FMT^ABMERUTL(ABMR(70,80),6)

90 ;Other Diagnosis Code #5, 55-60 (SOURCE: FILE=9002274.4017, FIELD=.01)

 ; from locator #72

 D GET17

 S ABMR(70,90)=ABM(17,6)

 S ABMR(70,90)=$$FMT^ABMERUTL(ABMR(70,90),6)

100 ;Other Diagnosis Code #6, 61-66 (SOURCE: FILE=9002274.4017, FIELD=.01)

 ; from locator #73

 D GET17

 S ABMR(70,100)=ABM(17,7)

 S ABMR(70,100)=$$FMT^ABMERUTL(ABMR(70,100),6)

110 ;Other Diagnosis Code #7, 67-72 (SOURCE: FILE=9002274.4017, FIELD=.01)

 ; from locator #74

 D GET17

 S ABMR(70,110)=ABM(17,8)

 S ABMR(70,110)=$$FMT^ABMERUTL(ABMR(70,110),6)

120 ;Other Diagnosis Code #8, 73-78 (SOURCE: FILE=9002274.4017, FIELD=.01)

 ; from locator #75

 D GET17

 S ABMR(70,120)=ABM(17,9)

 S ABMR(70,120)=$$FMT^ABMERUTL(ABMR(70,120),6)

GET17 ;GET DIAGNOSES CODES FROM BILL FILE

 Q:$D(ABM(17))

 N I,J

 S I=0,CNT=0

 F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I)) Q:'I  D

 .S J=0

 .F  S J=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I,J)) Q:'J  D

 ..S CNT=CNT+1

 ..S ABM(17,CNT)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,J,0),U) ; ICD Diagnosis IEN

 ..S ABM(17,CNT)=$P($$DX^ABMCVAPI(+ABM(17,CNT),ABMP("VDT")),U,2) ; ICD Diagnosis code  ;CSV-c

 ..Q:$P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"

 ..S ABM(17,CNT)=$TR(ABM(17,CNT),".")

 F I=1:1:9 S:'$D(ABM(17,I)) ABM(17,I)=""

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

ABME570A  ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 70-1 (Medical) cont'd ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;DMJ;

 +3       ;

 +4       ; IHS/SD/SDR - v2.6 CSV

 +5       ;

LOOP      ;LOOP HERE

 +1        FOR I=10:10:120

               Begin DoDot:1

 +2                DO @I

 +3                IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),70,I))

                       DO @(^(I))

 +4                IF '$GET(ABMP("NOFMT"))

                       SET ABMREC(70)=$GET(ABMREC(70))_ABMR(70,I)

               End DoDot:1

 +5        QUIT

 +6       ;

10        ;Record type, 1-2

 +1        SET ABMR(70,10)=70

 +2        QUIT

 +3       ;

20        ;Sequence , 3-4

 +1        SET ABMR(70,20)="01"

 +2        QUIT

 +3       ;

30        ;Patient Control Number, 5-24 (SOURCE: FILE=9000001.41,FIELD=.02)

 +1        SET ABMR(70,30)=$$EX^ABMER20(30,ABMP("BDFN"))

 +2        SET ABMR(70,30)=$$FMT^ABMERUTL(ABMR(70,30),20)

 +3        QUIT

 +4       ;

40        ;Principle Diagnosis Code, 25-30 (SOURCE: FILE=9002274.4017 FIELD=.01)

 +1       ; from locator #67

 +2        DO GET17

 +3        SET ABMR(70,40)=ABM(17,1)

 +4        SET ABMR(70,40)=$$FMT^ABMERUTL(ABMR(70,40),6)

 +5        QUIT

 +6       ;

50        ;Other Diagnosis Code #1, 31-36 (SOURCE: FILE=9002274.4017, FIELD=.01)

 +1       ; from locator #68

 +2        DO GET17

 +3        SET ABMR(70,50)=ABM(17,2)

 +4        SET ABMR(70,50)=$$FMT^ABMERUTL(ABMR(70,50),6)

 +5        QUIT

 +6       ;

60        ;Other Diagnosis Code #2, 37-42 (SOURCE: FILE=9002274.4017, FIELD=.01)

 +1       ; from locator #69

 +2        DO GET17

 +3        SET ABMR(70,60)=ABM(17,3)

 +4        SET ABMR(70,60)=$$FMT^ABMERUTL(ABMR(70,60),6)

 +5        QUIT

 +6       ;

70        ;Other Diagnosis Code #3, 43-48 (SOURCE: FILE=9002274.4017, FIELD=.01)

 +1       ; from locator #70

 +2        DO GET17

 +3        SET ABMR(70,70)=ABM(17,4)

 +4        SET ABMR(70,70)=$$FMT^ABMERUTL(ABMR(70,70),6)

 +5        QUIT

 +6       ;

80        ;Other Diagnosis Code #4, 49-54 (SOURCE: FILE=9002274.4017, FIELD=.01)

 +1       ; from locator #71

 +2        DO GET17

 +3        SET ABMR(70,80)=ABM(17,5)

 +4        SET ABMR(70,80)=$$FMT^ABMERUTL(ABMR(70,80),6)

 +5        QUIT

 +6       ;

90        ;Other Diagnosis Code #5, 55-60 (SOURCE: FILE=9002274.4017, FIELD=.01)

 +1       ; from locator #72

 +2        DO GET17

 +3        SET ABMR(70,90)=ABM(17,6)

 +4        SET ABMR(70,90)=$$FMT^ABMERUTL(ABMR(70,90),6)

 +5        QUIT

 +6       ;

100       ;Other Diagnosis Code #6, 61-66 (SOURCE: FILE=9002274.4017, FIELD=.01)

 +1       ; from locator #73

 +2        DO GET17

 +3        SET ABMR(70,100)=ABM(17,7)

 +4        SET ABMR(70,100)=$$FMT^ABMERUTL(ABMR(70,100),6)

 +5        QUIT

 +6       ;

110       ;Other Diagnosis Code #7, 67-72 (SOURCE: FILE=9002274.4017, FIELD=.01)

 +1       ; from locator #74

 +2        DO GET17

 +3        SET ABMR(70,110)=ABM(17,8)

 +4        SET ABMR(70,110)=$$FMT^ABMERUTL(ABMR(70,110),6)

 +5        QUIT

 +6       ;

120       ;Other Diagnosis Code #8, 73-78 (SOURCE: FILE=9002274.4017, FIELD=.01)

 +1       ; from locator #75

 +2        DO GET17

 +3        SET ABMR(70,120)=ABM(17,9)

 +4        SET ABMR(70,120)=$$FMT^ABMERUTL(ABMR(70,120),6)

 +5        QUIT

 +6       ;

GET17     ;GET DIAGNOSES CODES FROM BILL FILE

 +1        IF $DATA(ABM(17))

               QUIT

 +2        NEW I,J

 +3        SET I=0

           SET CNT=0

 +4        FOR

               SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I))

               IF 'I

                   QUIT

               Begin DoDot:1

 +5                SET J=0

 +6                FOR

                       SET J=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",I,J))

                       IF 'J

                           QUIT

                       Begin DoDot:2

 +7                        SET CNT=CNT+1

 +8       ; ICD Diagnosis IEN

                           SET ABM(17,CNT)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,J,0),U)

 +9       ; ICD Diagnosis code  ;CSV-c

                           SET ABM(17,CNT)=$PIECE($$DX^ABMCVAPI(+ABM(17,CNT),ABMP("VDT")),U,2)

 +10                       IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"

                               QUIT

 +11                       SET ABM(17,CNT)=$TRANSLATE(ABM(17,CNT),".")

                       End DoDot:2

               End DoDot:1

 +12       FOR I=1:1:9

               IF '$DATA(ABM(17,I))

                   SET ABM(17,I)=""

 +13       QUIT

 +14      ;

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

ABME570A.m