ABMUTL8A.m

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