ABMDMEDB.m

ABMDMEDB ;IHS/ASDST/DMJ - MEDICARE B CLAIM SPLIT  

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

 ;

 ; IHS/ASDS/DMJ - 09/11/01 - V2.4 Patch 7 - NOIS HQW-0701-100066

 ;     This is a new routine related to Medicare Part B.

 ;

 ; IHS/ASDS/DMJ - 10/19/01 - V2.4 Patch 9 - NOIS HQW-1001-100086

 ;     Allow one Part B claim for free standing clinics.

 ;

 ; IHS/SD/SDR - v2.5 p9 - IM16055

 ;    Corrected global reference

 ;

 ; *********************************************************************

 ;

START ;set start

 Q:$G(^ABMCNVRT("MEDB","START"))

 S ^ABMCNVRT("MEDB","START")=$H

ALL ;all sites

 S ABMDUZ2=DUZ(2)

 S DUZ(2)=0

 F  S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'DUZ(2)  Q:DUZ(2)'=+DUZ(2)  D

 .D ONE

 S DUZ(2)=ABMDUZ2

 K ABMDUZ2

 S ^ABMCNVRT("MEDB","STOP")=$H

 Q

ONE ;one site

 Q:$P($G(^ABMDPARM(DUZ(2),1,5)),U)

 W !!,"Site= ",$P(^AUTTLOC(DUZ(2),0),"^",2)

 S ABMDT=3010700

 F  S ABMDT=$O(^ABMDCLM(DUZ(2),"AD",ABMDT)) Q:'ABMDT  D

 .S ABMCLM=0

 .F  S ABMCLM=$O(^ABMDCLM(DUZ(2),"AD",ABMDT,ABMCLM)) Q:'ABMCLM  D

 ..D CLAIM

 Q

CLAIM ;one claim

 S ABMINS=+$P(^ABMDCLM(DUZ(2),ABMCLM,0),"^",8)

 Q:$P($G(^AUTNINS(ABMINS,2)),U)'="R"

 Q:$P(^ABMDCLM(DUZ(2),ABMCLM,0),"^",7)=999

 D MAIN^ABMDSPLB(ABMCLM)

 W "."

 Q

ABMDMEDB  ;IHS/ASDST/DMJ - MEDICARE B CLAIM SPLIT  

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

 +2       ;

 +3       ; IHS/ASDS/DMJ - 09/11/01 - V2.4 Patch 7 - NOIS HQW-0701-100066

 +4       ;     This is a new routine related to Medicare Part B.

 +5       ;

 +6       ; IHS/ASDS/DMJ - 10/19/01 - V2.4 Patch 9 - NOIS HQW-1001-100086

 +7       ;     Allow one Part B claim for free standing clinics.

 +8       ;

 +9       ; IHS/SD/SDR - v2.5 p9 - IM16055

 +10      ;    Corrected global reference

 +11      ;

 +12      ; *********************************************************************

 +13      ;

START     ;set start

 +1        IF $GET(^ABMCNVRT("MEDB","START"))

               QUIT 

 +2        SET ^ABMCNVRT("MEDB","START")=$HOROLOG

ALL       ;all sites

 +1        SET ABMDUZ2=DUZ(2)

 +2        SET DUZ(2)=0

 +3        FOR 

               SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))

               IF 'DUZ(2)

                   QUIT 

               IF DUZ(2)'=+DUZ(2)

                   QUIT 

               Begin DoDot:1

 +4                DO ONE

               End DoDot:1

 +5        SET DUZ(2)=ABMDUZ2

 +6        KILL ABMDUZ2

 +7        SET ^ABMCNVRT("MEDB","STOP")=$HOROLOG

 +8        QUIT 

ONE       ;one site

 +1        IF $PIECE($GET(^ABMDPARM(DUZ(2),1,5)),U)

               QUIT 

 +2        WRITE !!,"Site= ",$PIECE(^AUTTLOC(DUZ(2),0),"^",2)

 +3        SET ABMDT=3010700

 +4        FOR 

               SET ABMDT=$ORDER(^ABMDCLM(DUZ(2),"AD",ABMDT))

               IF 'ABMDT

                   QUIT 

               Begin DoDot:1

 +5                SET ABMCLM=0

 +6                FOR 

                       SET ABMCLM=$ORDER(^ABMDCLM(DUZ(2),"AD",ABMDT,ABMCLM))

                       IF 'ABMCLM

                           QUIT 

                       Begin DoDot:2

 +7                        DO CLAIM

                       End DoDot:2

               End DoDot:1

 +8        QUIT 

CLAIM     ;one claim

 +1        SET ABMINS=+$PIECE(^ABMDCLM(DUZ(2),ABMCLM,0),"^",8)

 +2        IF $PIECE($GET(^AUTNINS(ABMINS,2)),U)'="R"

               QUIT 

 +3        IF $PIECE(^ABMDCLM(DUZ(2),ABMCLM,0),"^",7)=999

               QUIT 

 +4        DO MAIN^ABMDSPLB(ABMCLM)

 +5        WRITE "."

 +6        QUIT