ABMDRRB ;IHS/ASDST/LSL - MEDICARE B CLAIM SPLIT FOR RAILROAD
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/ASDS/LSL - 10/01/01 - V2.4 Patch 9 - NOIS HQW-0701-100066
; This routine will go back to visit date 7/1/01 and split already
; created RailRoad Retirement claims for Part B
;
; IHS/SD/SDR - v2.5 p9 - IM16055
; Corrected global reference
;
; *********************************************************************
;
START ;
; set start
Q:$G(^ABMCNVRT("RRB","START"))
S ^ABMCNVRT("RRB","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("RRB","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(ABMCLM)
W "."
Q
;
; *********************************************************************
MAIN(ABMCF) ;
; Main section
; x = claim to clone
D CHK
I $G(ABMQUIT) K ABMQUIT Q
D ADD^ABMDSPLB
Q:Y<0
D EDIT^ABMDSPLB
D DEL^ABMDSPLB
D XREF^ABMDSPLB
K ABMCF,ABMC2
Q
;
; *********************************************************************
CHK ;
; checks create claim or quit
S ABMQUIT=1
Q:'$D(^ABMDCLM(DUZ(2),ABMCF,0))
S ABMCLM(0)=$G(^ABMDCLM(DUZ(2),ABMCF,0))
S ABMPAT=$P(ABMCLM(0),U)
S ABMDT=$P(ABMCLM(0),U,2)
S ABMVTYP=$P(ABMCLM(0),U,7)
S ABMINS=$P(ABMCLM(0),U,8)
Q:ABMDT<3010701
I '$$PARTB(ABMPAT,ABMDT) Q
D DUP^ABMDSPLB
I $G(ABMDUP) Q
K ABMQUIT
Q
;
; *********************************************************************
PARTB(X,Y) ;
; Check for part b
; x = patient dfn
; y = date
I 'X S Z=0 Q Z
I 'Y S Z=0 Q Z
S Z=0
N I
S I=0 F S I=$O(^AUPNRRE(X,11,I)) Q:'I D
.S ABMZERO=^AUPNRRE(X,11,I,0)
.D BSUB^ABMDSPLB
K ABMZERO
Q Z
ABMDRRB ;IHS/ASDST/LSL - MEDICARE B CLAIM SPLIT FOR RAILROAD
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/ASDS/LSL - 10/01/01 - V2.4 Patch 9 - NOIS HQW-0701-100066
+4 ; This routine will go back to visit date 7/1/01 and split already
+5 ; created RailRoad Retirement claims for Part B
+6 ;
+7 ; IHS/SD/SDR - v2.5 p9 - IM16055
+8 ; Corrected global reference
+9 ;
+10 ; *********************************************************************
+11 ;
START ;
+1 ; set start
+2 IF $GET(^ABMCNVRT("RRB","START"))
QUIT
+3 SET ^ABMCNVRT("RRB","START")=$HOROLOG
+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("RRB","STOP")=$HOROLOG
+9 QUIT
+10 ;
+11 ; *********************************************************************
ONE ;
+1 ; one site
+2 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,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 DO CLAIM
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
+11 ; *********************************************************************
CLAIM ;
+1 ; one claim
+2 SET ABMINS=+$PIECE(^ABMDCLM(DUZ(2),ABMCLM,0),"^",8)
+3 IF $PIECE($GET(^AUTNINS(ABMINS,2)),U)'="R"
QUIT
+4 IF $PIECE(^ABMDCLM(DUZ(2),ABMCLM,0),"^",7)=999
QUIT
+5 DO MAIN(ABMCLM)
+6 WRITE "."
+7 QUIT
+8 ;
+9 ; *********************************************************************
MAIN(ABMCF) ;
+1 ; Main section
+2 ; x = claim to clone
+3 DO CHK
+4 IF $GET(ABMQUIT)
KILL ABMQUIT
QUIT
+5 DO ADD^ABMDSPLB
+6 IF Y<0
QUIT
+7 DO EDIT^ABMDSPLB
+8 DO DEL^ABMDSPLB
+9 DO XREF^ABMDSPLB
+10 KILL ABMCF,ABMC2
+11 QUIT
+12 ;
+13 ; *********************************************************************
CHK ;
+1 ; checks create claim or quit
+2 SET ABMQUIT=1
+3 IF '$DATA(^ABMDCLM(DUZ(2),ABMCF,0))
QUIT
+4 SET ABMCLM(0)=$GET(^ABMDCLM(DUZ(2),ABMCF,0))
+5 SET ABMPAT=$PIECE(ABMCLM(0),U)
+6 SET ABMDT=$PIECE(ABMCLM(0),U,2)
+7 SET ABMVTYP=$PIECE(ABMCLM(0),U,7)
+8 SET ABMINS=$PIECE(ABMCLM(0),U,8)
+9 IF ABMDT<3010701
QUIT
+10 IF '$$PARTB(ABMPAT,ABMDT)
QUIT
+11 DO DUP^ABMDSPLB
+12 IF $GET(ABMDUP)
QUIT
+13 KILL ABMQUIT
+14 QUIT
+15 ;
+16 ; *********************************************************************
PARTB(X,Y) ;
+1 ; Check for part b
+2 ; x = patient dfn
+3 ; y = date
+4 IF 'X
SET Z=0
QUIT Z
+5 IF 'Y
SET Z=0
QUIT Z
+6 SET Z=0
+7 NEW I
+8 SET I=0
FOR
SET I=$ORDER(^AUPNRRE(X,11,I))
IF 'I
QUIT
Begin DoDot:1
+9 SET ABMZERO=^AUPNRRE(X,11,I,0)
+10 DO BSUB^ABMDSPLB
End DoDot:1
+11 KILL ABMZERO
+12 QUIT Z
