ABMRSTI1 ; IHS/SD/SDR - Split Claim Billing (part 2);
;;2.6;IHS 3P BILLING SYSTEM;**22**;NOV 12, 2009;Build 418
;IHS/SD/SDR 2.6*22 HEAT335246 - New routine
;
Q
SPLTCHK ;EP
;build list of visits associated with this claim
S ABMVDFN=0
S ABMCDFN=ABMP("CDFN")
F S ABMVDFN=$O(^ABMDCLM(DUZ(2),ABMCDFN,11,ABMVDFN)) Q:'ABMVDFN D
.S ABMCSTAT=$S($P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,22)'="":$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,22),1:"O") ;default to original if no split status
.S ABMP(ABMCSTAT,ABMVDFN)=""
.D BLDLST(ABMCSTAT)
;now go look for other claims with these same visits too
S ABMVDFN=0
F S ABMVDFN=$O(ABMP(ABMCSTAT,ABMVDFN)) Q:'ABMVDFN D
.S ABMCDFN=0
.F S ABMCDFN=$O(^ABMDCLM(DUZ(2),"AV",ABMVDFN,ABMCDFN)) Q:'ABMCDFN D
..I ABMP("CDFN")=ABMCDFN Q ;skip this entry, it's the claim we started with
..S ABMCSTAT=$S($P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,22)'="":$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,22),1:"O") ;default to original if no split status
..D BLDLST(ABMCSTAT)
Q
BLDLST(ABMS) ;EP
F ABMJ=23,35,37,43 D
.S ABMJI=0
.F S ABMJI=$O(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI)) Q:'ABMJI D
..S ABMCODE=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U)
..I ABMJ=23 D
...S ABMCODE=$S($P($G(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U,6)'="":$P(^(0),U,6),$P($G(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U,22):$$GET1^DIQ(52,$P($G(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U,22),".01","E"),1:ABMJI_"NORX#") ;RX#
...S ABMDESC=$$GET1^DIQ(50,$P($G(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U),".01","E")
..I ABMJ'=23 D
...S ABMCODE=$P($$CPT^ABMCVAPI($P($G(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U),$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,2)),U,2)
...S ABMDESC=$P($$CPT^ABMCVAPI(ABMCODE,$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,2)),U,3)
..S ABMMULT=$S(ABMJ=23:"8D",ABMJ=35:"8F",ABMJ=37:"8E",ABMJ="43":"8H",1:"8H")
..S ABMCK(ABMS,ABMCDFN,ABMMULT,ABMJI,ABMCODE)=ABMDESC
Q
VSTDISP ;EP
W !
F I=1:1:80 W "="
W !,"Visit Info:",!
W "PG (IEN)",?15,"REF#",?40,"DESCRIPTION",!
F I=1:1:80 W "-"
S ABMPGE=""
F S ABMPGE=$O(ABMP("VDETAIL",ABMPGE)) Q:$G(ABMPGE)="" D
.S ABMVFILE=""
.F S ABMVFILE=$O(ABMP("VDETAIL",ABMPGE,ABMVFILE)) Q:$G(ABMVFILE)="" D
..S ABMVIEN=0
..F S ABMVIEN=$O(ABMP("VDETAIL",ABMPGE,ABMVFILE,ABMVIEN)) Q:'ABMVIEN D
...W !,ABMPGE_" ("_ABMVIEN_")"
...;
...I ABMVFILE["VRAD" D
....S ABMREC=$$GET1^DIQ(81,$$GET1^DIQ(71,$P(@ABMVFILE@(ABMVIEN,0),U),"9","E"),".01","E")
....S ABMREC=ABMREC_U_$$GET1^DIQ(71,$P(@ABMVFILE@(ABMVIEN,0),U),".01","E")
...;
...I ABMVFILE["VMED" D
....S ABMR("X")=$O(^PSRX("APCC",ABMVIEN,""))
....I ABMR("X")'="" D
.....S ABMR("RX")=$P($G(^PSRX(ABMR("X"),0)),U)
.....S ABMR2=$G(^PSRX(ABMR("X"),2))
.....S ABMR("RTS")=$P(ABMR2,"^",15)
....I ABMR("X")="" S ABMR("RX")=$S($P($G(@ABMVFILE@(ABMVIEN,11)),U,2):$P($G(@ABMVFILE@(ABMVIEN,11)),U,2),1:"NO RX")
....S ABMREC=$S($P(@ABMVFILE@(ABMVIEN,0),U,8)'="":"(dd)",$G(ABMR("RTS"))'="":"(rts)",1:"")_ABMR("RX") ;rx#
....S ABMNDC=$S($$GET1^DIQ(50,$P(@ABMVFILE@(ABMVIEN,0),U),"31","E")'="":$$GET1^DIQ(50,$P(@ABMVFILE@(ABMVIEN,0),U),"31","E"),1:"")
....S ABMREC=ABMREC_U_$S(ABMNDC'="":ABMNDC_" ",1:"")_$$GET1^DIQ(50,$P(@ABMVFILE@(ABMVIEN,0),U),".01","E")
...;
...I ABMVFILE["VLAB" D
....S ABMREC=$P($P($G(@ABMVFILE@(ABMVIEN,14)),U,2),"|")
....I ABMREC="" S ABMREC="NOCPT"
....S ABMREC=ABMREC_U_$E($$GET1^DIQ(60,$P(@ABMVFILE@(ABMVIEN,0),U),".01","E"),1,30)
...;
...I ABMVFILE["VCPT" D
....S ABMREC=$$GET1^DIQ(81,$P(@ABMVFILE@(ABMVIEN,0),U),".01","E")
....S ABMREC=ABMREC_U_$E($P($$CPT^ABMCVAPI($P(@ABMVFILE@(ABMVIEN,0),U),$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,2)),U,3),1,60)
...;
...W ?15,$P(ABMREC,U) ;cpt/rx#
...W ?29,$E($P(ABMREC,U,2),1,50) ;description
Q
CLMDISP ;EP
W !!
F I=1:1:80 W "="
W !,"Claims:"
W !,"O/S",?6,"CLM#",?18,"PG",?21,"REF#",?35,"DESC",!
F I=1:1:80 W "-"
S ABMS=""
F S ABMS=$O(ABMCK(ABMS)) Q:$G(ABMS)="" D
.S ABMCDFN=0
.F S ABMCDFN=$O(ABMCK(ABMS,ABMCDFN)) Q:'ABMCDFN D
..W !,$S(ABMS="O":"Orig",1:"Splt"),?6,ABMCDFN
..S ABMJ=""
..F S ABMJ=$O(ABMCK(ABMS,ABMCDFN,ABMJ)) Q:$G(ABMJ)="" D
...S ABMJI=0
...F S ABMJI=$O(ABMCK(ABMS,ABMCDFN,ABMJ,ABMJI)) Q:'ABMJI D
....S ABMCODE=""
....F S ABMCODE=$O(ABMCK(ABMS,ABMCDFN,ABMJ,ABMJI,ABMCODE)) Q:$G(ABMCODE)="" D
.....W ?18,ABMJ,?21,$S(ABMCODE["NORX":"NO RX",1:ABMCODE),?33,$G(ABMCK(ABMS,ABMCDFN,ABMJ,ABMJI,ABMCODE)),!
Q
ABMRSTI1 ; IHS/SD/SDR - Split Claim Billing (part 2);
+1 ;;2.6;IHS 3P BILLING SYSTEM;**22**;NOV 12, 2009;Build 418
+2 ;IHS/SD/SDR 2.6*22 HEAT335246 - New routine
+3 ;
+4 QUIT
SPLTCHK ;EP
+1 ;build list of visits associated with this claim
+2 SET ABMVDFN=0
+3 SET ABMCDFN=ABMP("CDFN")
+4 FOR
SET ABMVDFN=$ORDER(^ABMDCLM(DUZ(2),ABMCDFN,11,ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:1
+5 ;default to original if no split status
SET ABMCSTAT=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,22)'="":$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,22),1:"O")
+6 SET ABMP(ABMCSTAT,ABMVDFN)=""
+7 DO BLDLST(ABMCSTAT)
End DoDot:1
+8 ;now go look for other claims with these same visits too
+9 SET ABMVDFN=0
+10 FOR
SET ABMVDFN=$ORDER(ABMP(ABMCSTAT,ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:1
+11 SET ABMCDFN=0
+12 FOR
SET ABMCDFN=$ORDER(^ABMDCLM(DUZ(2),"AV",ABMVDFN,ABMCDFN))
IF 'ABMCDFN
QUIT
Begin DoDot:2
+13 ;skip this entry, it's the claim we started with
IF ABMP("CDFN")=ABMCDFN
QUIT
+14 ;default to original if no split status
SET ABMCSTAT=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,22)'="":$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,22),1:"O")
+15 DO BLDLST(ABMCSTAT)
End DoDot:2
End DoDot:1
+16 QUIT
BLDLST(ABMS) ;EP
+1 FOR ABMJ=23,35,37,43
Begin DoDot:1
+2 SET ABMJI=0
+3 FOR
SET ABMJI=$ORDER(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI))
IF 'ABMJI
QUIT
Begin DoDot:2
+4 SET ABMCODE=$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U)
+5 IF ABMJ=23
Begin DoDot:3
+6 ;RX#
SET ABMCODE=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U,6)'="":$PIECE(^(0),U,6),$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U,22):$$GET1^DIQ(52,$PIECE(...
... $GET(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U,22),".01","E"),1:ABMJI_"NORX#")
+7 SET ABMDESC=$$GET1^DIQ(50,$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U),".01","E")
End DoDot:3
+8 IF ABMJ'=23
Begin DoDot:3
+9 SET ABMCODE=$PIECE($$CPT^ABMCVAPI($PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,ABMJ,ABMJI,0)),U),$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,2)),U,2)
+10 SET ABMDESC=$PIECE($$CPT^ABMCVAPI(ABMCODE,$PIECE($GET(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,2)),U,3)
End DoDot:3
+11 SET ABMMULT=$SELECT(ABMJ=23:"8D",ABMJ=35:"8F",ABMJ=37:"8E",ABMJ="43":"8H",1:"8H")
+12 SET ABMCK(ABMS,ABMCDFN,ABMMULT,ABMJI,ABMCODE)=ABMDESC
End DoDot:2
End DoDot:1
+13 QUIT
VSTDISP ;EP
+1 WRITE !
+2 FOR I=1:1:80
WRITE "="
+3 WRITE !,"Visit Info:",!
+4 WRITE "PG (IEN)",?15,"REF#",?40,"DESCRIPTION",!
+5 FOR I=1:1:80
WRITE "-"
+6 SET ABMPGE=""
+7 FOR
SET ABMPGE=$ORDER(ABMP("VDETAIL",ABMPGE))
IF $GET(ABMPGE)=""
QUIT
Begin DoDot:1
+8 SET ABMVFILE=""
+9 FOR
SET ABMVFILE=$ORDER(ABMP("VDETAIL",ABMPGE,ABMVFILE))
IF $GET(ABMVFILE)=""
QUIT
Begin DoDot:2
+10 SET ABMVIEN=0
+11 FOR
SET ABMVIEN=$ORDER(ABMP("VDETAIL",ABMPGE,ABMVFILE,ABMVIEN))
IF 'ABMVIEN
QUIT
Begin DoDot:3
+12 WRITE !,ABMPGE_" ("_ABMVIEN_")"
+13 ;
+14 IF ABMVFILE["VRAD"
Begin DoDot:4
+15 SET ABMREC=$$GET1^DIQ(81,$$GET1^DIQ(71,$PIECE(@ABMVFILE@(ABMVIEN,0),U),"9","E"),".01","E")
+16 SET ABMREC=ABMREC_U_$$GET1^DIQ(71,$PIECE(@ABMVFILE@(ABMVIEN,0),U),".01","E")
End DoDot:4
+17 ;
+18 IF ABMVFILE["VMED"
Begin DoDot:4
+19 SET ABMR("X")=$ORDER(^PSRX("APCC",ABMVIEN,""))
+20 IF ABMR("X")'=""
Begin DoDot:5
+21 SET ABMR("RX")=$PIECE($GET(^PSRX(ABMR("X"),0)),U)
+22 SET ABMR2=$GET(^PSRX(ABMR("X"),2))
+23 SET ABMR("RTS")=$PIECE(ABMR2,"^",15)
End DoDot:5
+24 IF ABMR("X")=""
SET ABMR("RX")=$SELECT($PIECE($GET(@ABMVFILE@(ABMVIEN,11)),U,2):$PIECE($GET(@ABMVFILE@(ABMVIEN,11)),U,2),1:"NO RX")
+25 ;rx#
SET ABMREC=$SELECT($PIECE(@ABMVFILE@(ABMVIEN,0),U,8)'="":"(dd)",$GET(ABMR("RTS"))'="":"(rts)",1:"")_ABMR("RX")
+26 SET ABMNDC=$SELECT($$GET1^DIQ(50,$PIECE(@ABMVFILE@(ABMVIEN,0),U),"31","E")'="":$$GET1^DIQ(50,$PIECE(@ABMVFILE@(ABMVIEN,0),U),"31","E"),1:"")
+27 SET ABMREC=ABMREC_U_$SELECT(ABMNDC'="":ABMNDC_" ",1:"")_$$GET1^DIQ(50,$PIECE(@ABMVFILE@(ABMVIEN,0),U),".01","E")
End DoDot:4
+28 ;
+29 IF ABMVFILE["VLAB"
Begin DoDot:4
+30 SET ABMREC=$PIECE($PIECE($GET(@ABMVFILE@(ABMVIEN,14)),U,2),"|")
+31 IF ABMREC=""
SET ABMREC="NOCPT"
+32 SET ABMREC=ABMREC_U_$EXTRACT($$GET1^DIQ(60,$PIECE(@ABMVFILE@(ABMVIEN,0),U),".01","E"),1,30)
End DoDot:4
+33 ;
+34 IF ABMVFILE["VCPT"
Begin DoDot:4
+35 SET ABMREC=$$GET1^DIQ(81,$PIECE(@ABMVFILE@(ABMVIEN,0),U),".01","E")
+36 SET ABMREC=ABMREC_U_$EXTRACT($PIECE($$CPT^ABMCVAPI($PIECE(@ABMVFILE@(ABMVIEN,0),U),$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,2)),U,3),1,60)
End DoDot:4
+37 ;
+38 ;cpt/rx#
WRITE ?15,$PIECE(ABMREC,U)
+39 ;description
WRITE ?29,$EXTRACT($PIECE(ABMREC,U,2),1,50)
End DoDot:3
End DoDot:2
End DoDot:1
+40 QUIT
CLMDISP ;EP
+1 WRITE !!
+2 FOR I=1:1:80
WRITE "="
+3 WRITE !,"Claims:"
+4 WRITE !,"O/S",?6,"CLM#",?18,"PG",?21,"REF#",?35,"DESC",!
+5 FOR I=1:1:80
WRITE "-"
+6 SET ABMS=""
+7 FOR
SET ABMS=$ORDER(ABMCK(ABMS))
IF $GET(ABMS)=""
QUIT
Begin DoDot:1
+8 SET ABMCDFN=0
+9 FOR
SET ABMCDFN=$ORDER(ABMCK(ABMS,ABMCDFN))
IF 'ABMCDFN
QUIT
Begin DoDot:2
+10 WRITE !,$SELECT(ABMS="O":"Orig",1:"Splt"),?6,ABMCDFN
+11 SET ABMJ=""
+12 FOR
SET ABMJ=$ORDER(ABMCK(ABMS,ABMCDFN,ABMJ))
IF $GET(ABMJ)=""
QUIT
Begin DoDot:3
+13 SET ABMJI=0
+14 FOR
SET ABMJI=$ORDER(ABMCK(ABMS,ABMCDFN,ABMJ,ABMJI))
IF 'ABMJI
QUIT
Begin DoDot:4
+15 SET ABMCODE=""
+16 FOR
SET ABMCODE=$ORDER(ABMCK(ABMS,ABMCDFN,ABMJ,ABMJI,ABMCODE))
IF $GET(ABMCODE)=""
QUIT
Begin DoDot:5
+17 WRITE ?18,ABMJ,?21,$SELECT(ABMCODE["NORX":"NO RX",1:ABMCODE),?33,$GET(ABMCK(ABMS,ABMCDFN,ABMJ,ABMJI,ABMCODE)),!
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
