Routine: ABMPST10

ABMPST10 ; IHS/ASDS/LSL - V2.4 Patch 10 Post init

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

 ; IHS/ASDS/LSL - V2.4 Patch 10 - NOIS QBA-1201-130010

 ;     loop MCR part B that were created in patch 7 and

 ;     make Medicare active.

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

PATCH10 ;

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

 S ^ABMCNVRT("MCRC","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("MCRC","STOP")=$H

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

ONE ;

 ; one site

 Q:$P($G(^ABMDPARM(DUZ(2),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

 . . Q:'$D(^ABMDCLM(DUZ(2),ABMCLM))

 . . Q:$P(^ABMDCLM(DUZ(2),ABMCLM,0),"^",7)'=999  ;must be prof comp

 . . D CLAIM

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

CLAIM ;

 ; one claim

 S (ABMPRI,ABMDONE)=0

 F  S ABMPRI=$O(^ABMDCLM(DUZ(2),ABMCLM,13,"C",ABMPRI)) Q:'+ABMPRI  D  Q:ABMDONE

 . S ABM13=0

 . F  S ABM13=$O(^ABMDCLM(DUZ(2),ABMCLM,13,"C",ABMPRI,ABM13))  Q:'+ABM13  D  Q:ABMDONE

 . . Q:'$D(^ABMDCLM(DUZ(2),ABMCLM,13,ABM13))

 . . S ABMINS=$P($G(^ABMDCLM(DUZ(2),ABMCLM,13,ABM13,0)),U)

 . . I $P($G(^AUTNINS(ABMINS,2)),U)="R" S ABMDONE=1 Q

 Q:'ABMDONE

 Q:$P($G(^ABMDCLM(DUZ(2),ABMCLM,13,ABM13,0)),U,3)'="C"

 S ABMBILL=$O(^ABMDBILL(DUZ(2),"B",ABMCLM_" "))

 ; If no bill for this claim do the following:

 I ABMCLM'=+ABMBILL D

 . W !,ABMCLM

. Q

 . S DIE="^ABMDCLM(DUZ(2),"

 . S DA=ABMCLM

 . S DR=".08////^S X=ABMINS"

 . D ^DIE

 . S DIE="^ABMDCLM(DUZ(2),"_ABMCLM_",13,"

 . S DA(1)=ABMCLM

 . S DA=ABM13

 . S DR=".03////I"

 . D ^DIE

 . K DR,DA,DIE

ABMPST10  ; IHS/ASDS/LSL - V2.4 Patch 10 Post init

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

 +2       ;

 +3       ; IHS/ASDS/LSL - V2.4 Patch 10 - NOIS QBA-1201-130010

 +4       ;     loop MCR part B that were created in patch 7 and

 +5       ;     make Medicare active.

 +6       ;

 +7       ; *********************************************************************

PATCH10   ;

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

               QUIT

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

 +3       ;

 +4       ; *********************************************************************

ALL       ;

 +1       ; all sites

 +2        SET ABMDUZ2=DUZ(2)

 +3        SET DUZ(2)=0

 +4        FOR

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

               IF 'DUZ(2)

                   QUIT

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

                   QUIT

               Begin DoDot:1

 +5                DO ONE

               End DoDot:1

 +6        SET DUZ(2)=ABMDUZ2

 +7        KILL ABMDUZ2

 +8        SET ^ABMCNVRT("MCRC","STOP")=$HOROLOG

 +9        QUIT

 +10      ;

 +11      ; *********************************************************************

ONE       ;

 +1       ; one site

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

               QUIT

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

 +4        SET ABMDT=3010700

 +5        FOR

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

               IF 'ABMDT

                   QUIT

               Begin DoDot:1

 +6                SET ABMCLM=0

 +7                FOR

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

                       IF 'ABMCLM

                           QUIT

                       Begin DoDot:2

 +8                        IF '$DATA(^ABMDCLM(DUZ(2),ABMCLM))

                               QUIT

 +9       ;must be prof comp

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

                               QUIT

 +10                       DO CLAIM

                       End DoDot:2

               End DoDot:1

 +11       QUIT

 +12      ;

 +13      ; *********************************************************************

CLAIM     ;

 +1       ; one claim

 +2        SET (ABMPRI,ABMDONE)=0

 +3        FOR

               SET ABMPRI=$ORDER(^ABMDCLM(DUZ(2),ABMCLM,13,"C",ABMPRI))

               IF '+ABMPRI

                   QUIT

               Begin DoDot:1

 +4                SET ABM13=0

 +5                FOR

                       SET ABM13=$ORDER(^ABMDCLM(DUZ(2),ABMCLM,13,"C",ABMPRI,ABM13))

                       IF '+ABM13

                           QUIT

                       Begin DoDot:2

 +6                        IF '$DATA(^ABMDCLM(DUZ(2),ABMCLM,13,ABM13))

                               QUIT

 +7                        SET ABMINS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMCLM,13,ABM13,0)),U)

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

                               SET ABMDONE=1

                               QUIT

                       End DoDot:2

                       IF ABMDONE

                           QUIT

               End DoDot:1

               IF ABMDONE

                   QUIT

 +9        IF 'ABMDONE

               QUIT

 +10       IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMCLM,13,ABM13,0)),U,3)'="C"

               QUIT

 +11       SET ABMBILL=$ORDER(^ABMDBILL(DUZ(2),"B",ABMCLM_" "))

 +12      ;

 +13      ; If no bill for this claim do the following:

 +14       IF ABMCLM'=+ABMBILL

               Begin DoDot:1

 +15               WRITE !,ABMCLM

 +16               QUIT

 +17               SET DIE="^ABMDCLM(DUZ(2),"

 +18               SET DA=ABMCLM

 +19               SET DR=".08////^S X=ABMINS"

 +20               DO ^DIE

 +21               SET DIE="^ABMDCLM(DUZ(2),"_ABMCLM_",13,"

 +22               SET DA(1)=ABMCLM

 +23               SET DA=ABM13

 +24               SET DR=".03////I"

 +25               DO ^DIE

 +26               KILL DR,DA,DIE

               End DoDot:1

 +27       QUIT

ABMPST10.m