Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDVS11

ABMDVS11.m

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