- 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
