- 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
