ABMDVS11 ; IHS/ASDST/DMJ - PCC VISIT STUFF, LABORATORY ;
;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009
;Original;JLG
;New version to get the CPT codes etc out of V LAB file.
;
;note: Lab CPT file must be populated with cpt data
;
;IHS/DSD/JLG - 05/21/98 - NCA-0598-180077
; Modified to set correspond diagnosis if only one POV
;IHS/DSD/MRS - 08/13/99 - NOIS XFA-0498-200014 Patch 3 #9
; Modified to get revenue code from file 81 or 81.1
;
; IHS/SD/SDR - v2.6 CSV
; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI
;
Q:ABMIDONE
START ;START HERE
D LAB("^AUPNVLAB") ;Chem and hema
D LAB("^AUPNVMIC") ;Micro
D LAB("^AUPNVPTH") ;Pathology
D LAB("^AUPNVBB") ;Blood Bank
D LAB("^AUPNVCYT") ;Cyto (does not actually exist as of 10/11/96)
Q
;
LAB(VFILE) ;VFILE is the V file global name
;This subrtn goes thru the visits in the V file
;The info that is needed is CPT code, revenue code from CPT string,
;units, and charge. Units should always be 1. Charge is from the
;fee schedule file
N L,T,L11,L12,COLDATE,ORDPROV,CPTSTR,CPT,MODIFIER,FILEN
S L=0 F S L=$O(@VFILE@("AD",ABMVDFN,L)) Q:'L D
.;T first piece is test, S is site
.S T=$G(@VFILE@(+L,0)) Q:'T
.S L11=$G(@VFILE@(L,11))
.Q:"OAD"[$P(L11,U,9) ;Is the test verified
.Q:$P(L11,U,11)=0 ;Make sure it is billable
.S L12=$G(@VFILE@(L,12))
.Q:$P(L12,U,8)]"" ;Quit if it has a parent
.S COLDATE=+L12
.S ORDPROV=$P(L12,U,2)
.Q:'$D(@VFILE@(L,14))
.S CPTSTR=$P(@VFILE@(L,14),U,2)
.S FILEN=$P(+$P(@VFILE@(0),U,2),".",2)
.S:VFILE["VLAB"&($P(@VFILE@(+L,0),U,4)'="") RESULT=$P(@VFILE@(+L,0),U,4)
.D CPTSTR
Q
;
CPTSTR ;Parse CPTSTR and edit claim
;Top delimiter is ; between CPT's. Each CPT is of the form
;CPT code|cost|rev code|action code|modifier|qualifier
;Each modifier and qualifier can be multiple separated by ,
;Note that rev code being passed by lab is not revenue code
N ABMI,J,REVCODE,X
F ABMI=1:1 S X=$P(CPTSTR,";",ABMI) Q:X="" D
.S ABMSRC=FILEN_"|"_L_","_ABMI_"|CPT"
.S CPT=$P(X,"|",1)
.S M=$P(X,"|",5)
.F J=1:1 S MODIFIER(J)=$P(M,",",J) I MODIFIER(J)="" K MODIFIER(J) Q
.S REVCODE=$P($$IHSCPT^ABMCVAPI(CPT,ABMP("VDT")),U,3) ;CSV-c
.I 'REVCODE D
..N CPTCTIEN
..S CPTCTIEN=$P($$CPT^ABMCVAPI(CPT,ABMP("VDT")),U,4) ;CSV-c
..Q:'CPTCTIEN
..S REVCODE=$P($$IHSCAT^ABMCVAPI(CPTCTIEN,ABMP("VDT")),U) ;CSV-c
.S:'REVCODE REVCODE=300
.D CLAIM
K M
Q
;
CLAIM ;-- claim file stuff
N FEE
;ABMP("FEE") gets set in ABMDE2X1 or ABMDE2X5 which are called from
;ABMDVST
;S FEE=$P($G(^ABMDFEE(+ABMP("FEE"),17,CPT,0)),U,2) ;abm*2.6*2 3PMS10003A
S FEE=$P($$ONE^ABMFEAPI(+ABMP("FEE"),17,CPT,ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A
I ($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"),('FEE) Q
S DIC("P")=$P(^DD(9002274.3,37,0),U,2)
K DIC,DD,DO
S X=CPT,DIC="^ABMDCLM("_DUZ(2)_","_ABMP("CDFN")_",37,"
S DIC("DR")=".02////"_REVCODE_";.03////1;.04////"_FEE_";.05////"_COLDATE_";.17////"_ABMSRC
I +$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",CPT,0))'=0 D
.Q:ABMP("EXP")'=22
.Q:'$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",CPT))
.S ABMIIEN=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",CPT,0))
.Q:$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,ABMIIEN,0)),U,2)'="Y"
.I +$G(RESULT) S DIC("DR")=DIC("DR")_";.21////"_RESULT
I $D(ABMP("CORRSDIAG")) S DIC("DR")=DIC("DR")_";.09////1"
I $D(MODIFIER) F J=1:1:3 Q:'$D(MODIFIER(J)) D
.S DIC("DR")=DIC("DR")_";"_((5+J)/100)_"////"_MODIFIER(J)
S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),"ASRC",ABMSRC,0))
I DA,'$D(@(DIC_DA_",0)")) S DA="" ;For duplicates problem
S DA(1)=ABMP("CDFN")
I DA>0 D
.K DR
.S DIE=DIC
.S DR=".01///"_X_";"_DIC("DR")
.D ^DIE
E D
.S DIC(0)="LE"
.S DIC("P")=$P(^DD(9002274.3,37,0),U,2)
.K DD,DO
.K DD,DO D FILE^DICN
Q
ABMDVS11 ; IHS/ASDST/DMJ - PCC VISIT STUFF, LABORATORY ;
+1 ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009
+2 ;Original;JLG
+3 ;New version to get the CPT codes etc out of V LAB file.
+4 ;
+5 ;note: Lab CPT file must be populated with cpt data
+6 ;
+7 ;IHS/DSD/JLG - 05/21/98 - NCA-0598-180077
+8 ; Modified to set correspond diagnosis if only one POV
+9 ;IHS/DSD/MRS - 08/13/99 - NOIS XFA-0498-200014 Patch 3 #9
+10 ; Modified to get revenue code from file 81 or 81.1
+11 ;
+12 ; IHS/SD/SDR - v2.6 CSV
+13 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI
+14 ;
+15 IF ABMIDONE
QUIT
START ;START HERE
+1 ;Chem and hema
DO LAB("^AUPNVLAB")
+2 ;Micro
DO LAB("^AUPNVMIC")
+3 ;Pathology
DO LAB("^AUPNVPTH")
+4 ;Blood Bank
DO LAB("^AUPNVBB")
+5 ;Cyto (does not actually exist as of 10/11/96)
DO LAB("^AUPNVCYT")
+6 QUIT
+7 ;
LAB(VFILE) ;VFILE is the V file global name
+1 ;This subrtn goes thru the visits in the V file
+2 ;The info that is needed is CPT code, revenue code from CPT string,
+3 ;units, and charge. Units should always be 1. Charge is from the
+4 ;fee schedule file
+5 NEW L,T,L11,L12,COLDATE,ORDPROV,CPTSTR,CPT,MODIFIER,FILEN
+6 SET L=0
FOR
SET L=$ORDER(@VFILE@("AD",ABMVDFN,L))
IF 'L
QUIT
Begin DoDot:1
+7 ;T first piece is test, S is site
+8 SET T=$GET(@VFILE@(+L,0))
IF 'T
QUIT
+9 SET L11=$GET(@VFILE@(L,11))
+10 ;Is the test verified
IF "OAD"[$PIECE(L11,U,9)
QUIT
+11 ;Make sure it is billable
IF $PIECE(L11,U,11)=0
QUIT
+12 SET L12=$GET(@VFILE@(L,12))
+13 ;Quit if it has a parent
IF $PIECE(L12,U,8)]""
QUIT
+14 SET COLDATE=+L12
+15 SET ORDPROV=$PIECE(L12,U,2)
+16 IF '$DATA(@VFILE@(L,14))
QUIT
+17 SET CPTSTR=$PIECE(@VFILE@(L,14),U,2)
+18 SET FILEN=$PIECE(+$PIECE(@VFILE@(0),U,2),".",2)
+19 IF VFILE["VLAB"&($PIECE(@VFILE@(+L,0),U,4)'="")
SET RESULT=$PIECE(@VFILE@(+L,0),U,4)
+20 DO CPTSTR
End DoDot:1
+21 QUIT
+22 ;
CPTSTR ;Parse CPTSTR and edit claim
+1 ;Top delimiter is ; between CPT's. Each CPT is of the form
+2 ;CPT code|cost|rev code|action code|modifier|qualifier
+3 ;Each modifier and qualifier can be multiple separated by ,
+4 ;Note that rev code being passed by lab is not revenue code
+5 NEW ABMI,J,REVCODE,X
+6 FOR ABMI=1:1
SET X=$PIECE(CPTSTR,";",ABMI)
IF X=""
QUIT
Begin DoDot:1
+7 SET ABMSRC=FILEN_"|"_L_","_ABMI_"|CPT"
+8 SET CPT=$PIECE(X,"|",1)
+9 SET M=$PIECE(X,"|",5)
+10 FOR J=1:1
SET MODIFIER(J)=$PIECE(M,",",J)
IF MODIFIER(J)=""
KILL MODIFIER(J)
QUIT
+11 ;CSV-c
SET REVCODE=$PIECE($$IHSCPT^ABMCVAPI(CPT,ABMP("VDT")),U,3)
+12 IF 'REVCODE
Begin DoDot:2
+13 NEW CPTCTIEN
+14 ;CSV-c
SET CPTCTIEN=$PIECE($$CPT^ABMCVAPI(CPT,ABMP("VDT")),U,4)
+15 IF 'CPTCTIEN
QUIT
+16 ;CSV-c
SET REVCODE=$PIECE($$IHSCAT^ABMCVAPI(CPTCTIEN,ABMP("VDT")),U)
End DoDot:2
+17 IF 'REVCODE
SET REVCODE=300
+18 DO CLAIM
End DoDot:1
+19 KILL M
+20 QUIT
+21 ;
CLAIM ;-- claim file stuff
+1 NEW FEE
+2 ;ABMP("FEE") gets set in ABMDE2X1 or ABMDE2X5 which are called from
+3 ;ABMDVST
+4 ;S FEE=$P($G(^ABMDFEE(+ABMP("FEE"),17,CPT,0)),U,2) ;abm*2.6*2 3PMS10003A
+5 ;abm*2.6*2 3PMS10003A
SET FEE=$PIECE($$ONE^ABMFEAPI(+ABMP("FEE"),17,CPT,ABMP("VDT")),U)
+6 IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")
IF ('FEE)
QUIT
+7 SET DIC("P")=$PIECE(^DD(9002274.3,37,0),U,2)
+8 KILL DIC,DD,DO
+9 SET X=CPT
SET DIC="^ABMDCLM("_DUZ(2)_","_ABMP("CDFN")_",37,"
+10 SET DIC("DR")=".02////"_REVCODE_";.03////1;.04////"_FEE_";.05////"_COLDATE_";.17////"_ABMSRC
+11 IF +$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",CPT,0))'=0
Begin DoDot:1
+12 IF ABMP("EXP")'=22
QUIT
+13 IF '$DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",CPT))
QUIT
+14 SET ABMIIEN=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",CPT,0))
+15 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,ABMIIEN,0)),U,2)'="Y"
QUIT
+16 IF +$GET(RESULT)
SET DIC("DR")=DIC("DR")_";.21////"_RESULT
End DoDot:1
+17 IF $DATA(ABMP("CORRSDIAG"))
SET DIC("DR")=DIC("DR")_";.09////1"
+18 IF $DATA(MODIFIER)
FOR J=1:1:3
IF '$DATA(MODIFIER(J))
QUIT
Begin DoDot:1
+19 SET DIC("DR")=DIC("DR")_";"_((5+J)/100)_"////"_MODIFIER(J)
End DoDot:1
+20 SET DA=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),"ASRC",ABMSRC,0))
+21 ;For duplicates problem
IF DA
IF '$DATA(@(DIC_DA_",0)"))
SET DA=""
+22 SET DA(1)=ABMP("CDFN")
+23 IF DA>0
Begin DoDot:1
+24 KILL DR
+25 SET DIE=DIC
+26 SET DR=".01///"_X_";"_DIC("DR")
+27 DO ^DIE
End DoDot:1
+28 IF '$TEST
Begin DoDot:1
+29 SET DIC(0)="LE"
+30 SET DIC("P")=$PIECE(^DD(9002274.3,37,0),U,2)
+31 KILL DD,DO
+32 KILL DD,DO
DO FILE^DICN
End DoDot:1
+33 QUIT
