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
Q
;
; *********************************************************************
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
Q
;
; *********************************************************************
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
Q
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
