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

ABMDIPS.m

Go to the documentation of this file. 
  1. ABMDIPS ; IHS/ASDST/DMJ - GENERATE BILLS FOR PHYSICIAN IP SVCS. ;  
  1.  ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009
  1.  ;
  1.  ;IHS/DSD/MRS - 8/3/1999 NOIS XAA-0899-200005 Patch 3 #7
  1.  ;      Changed variable name from ABMIO to ABMI0
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - modified to call ABMFEAPI
  1.  ;
  1. START ;START
  1.  K ABMQUIT
  1.  W $$EN^ABMVDF("IOF")
  1.  W !!,"This option will generate 3P Bills"
  1.  W !,"for inpatient physician services.",!
  1.  W !,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF"),"To use this option an inpatient bill must already exist"
  1.  W !,"in 3P Bill File.",!!
  1. PAY ;enter payer     
  1.  K DIC
  1.  S DIC("B")="ARIZONA MEDICAID"
  1.  S DIC="^AUTNINS(",DIC(0)="AEMQ"
  1.  D ^DIC Q:+Y<0
  1.  S ABMINS=+Y
  1.  S ABMITYP=$P($G(^AUTNINS(ABMINS,2)),U)
  1.  S ABMINAME=$P(^AUTNINS(ABMINS,0),U)
  1.  ; Check for proper insurer file setup
  1.  S ABMI0=$G(^ABMNINS(DUZ(2),ABMINS,1,141,0))
  1.  I ABMI0="" D  Q
  1.  .W *7,!,"Inpatient Physician Services not authorized for ",ABMINAME
  1.  .W !,"Need to add Visit Type 141 for insurer in Table Maintenance."
  1.  .D EOP^ABMDUTL(1)
  1. CODE ;enter procedure code
  1.  S ABMCODE=$P(ABMI0,"^",16)
  1.  S:ABMCODE ABMCODE=$P($$CPT^ABMCVAPI(ABMCODE,ABMP("VDT")),U,2)  ;CSV-c
  1.  K DIC
  1.  S DIC="^ICPT(",DIC(0)="AEMQ"
  1.  S DIC("A")="Enter HCPCS Code: "
  1.  S DIC("B")=$G(ABMCODE)
  1.  D ^DIC Q:+Y<0
  1.  S ABMCODE=+Y
  1. RATE ;get rate
  1.  F ABMI=13,27 D
  1.  .S ABMDA=$O(^ABMDFEE(1,ABMI,"B",ABMCODE,0))
  1.  .Q:'ABMDA
  1.  .;S ABMRATE=$P(^ABMDFEE(1,ABMI,ABMDA,0),"^",2)  ;abm*2.6*2 3PMS10003A
  1.  .S ABMRATE=$P($$ONE^ABMFEAPI(1,ABMI,ABMDA,$S($G(ABMP("VDT")):ABMP("VDT"),1:DT)),U)  ;abm*2.6*2 3PMS10003A
  1.  S DIR("A")="Enter Charge"
  1.  S DIR("B")=$G(ABMRATE)
  1.  S DIR(0)="N" D ^DIR K DIR
  1.  S ABMRATE=Y
  1. EXP ;mode of export
  1.  S ABMMOE=$P(ABMI0,"^",4)
  1.  I 'ABMMOE D
  1.  .W !
  1.  .K DIC S DIC="^ABMDEXP(",DIC(0)="AEMQ"
  1.  .D ^DIC S ABMMOE=+Y
  1.  Q:ABMMOE<0
  1.  S:^ABMDEXP(ABMMOE,0)["UB" ABMUB=1
  1. REV ;revenue code
  1.  I $G(ABMUB) D
  1.  .S ABMRVCD=$P(ABMI0,"^",3)
  1.  .Q:ABMRVCD
  1.  .W !
  1.  .K DIC S DIC="^AUTTREVN(",DIC(0)="AEMQ"
  1.  .S DIC("A")="Enter Revenue Code: "
  1.  .D ^DIC S ABMRVCD=+Y
  1. ASK ;ask look-up method
  1.  S DIR(0)="S^1:LOOP;2:INDIVIDUAL BILL"
  1.  S DIR("A")="Select Method of Bill Look-up"
  1.  S DIR("B")="LOOP"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABM(1)="LOOP"
  1.  S ABM(2)="IND"
  1.  D @ABM(Y)
  1.  S DIR("A")="Done - enter RETURN to continue" D EOP^ABMDUTL(0)
  1.  K ABMDUP,ABMPHY,ABMCODE,ABMPAT,ABMBATCH,ABMQUIT,ABMINS,ABMDTF,ABMDTT,ABMUNIT,ABMDICSV,ABMBNAME,ABM,ABMMOE,ABMI0,ABMRVCD,DIC
  1.  Q
  1. LOOP ;LOOP HERE
  1.  W !!,"Begin Loop",!
  1.  S %DT("A")="Go Back to Date: "
  1.  S %DT("B")="01/01/97"
  1.  S %DT="AEP"
  1.  D ^%DT
  1.  Q:Y<0  S ABMSDT=+Y
  1.  S ABMP("BDFN")=+$G(^ABMDTMP("IPSVC",ABMINAME,"LAST"))
  1. BY ;bypass with different ien
  1.  F  S ABMP("BDFN")=$O(^ABMDBILL(DUZ(2),"AJ",ABMINS,ABMP("BDFN"))) Q:'ABMP("BDFN")  D  Q:$G(ABMQUIT)
  1.  .Q:$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)<ABMSDT
  1.  .D SET
  1.  .Q:$P(ABMZERO,"^",7)'=111
  1.  .D ONE
  1.  .S ^ABMDTMP("IPSVC",ABMINAME,"LAST")=ABMP("BDFN")
  1.  .W ! S DIR(0)="E",DIR("A")="Enter RETURN to Continue Looping, ""^"" to Quit"
  1.  .D ^DIR K DIR
  1.  .K:Y ABMQUIT
  1.  Q
  1. IND ;process one at a time
  1.  F  D  Q:'$G(ABMP("BDFN"))
  1.  .D ^ABMDBLK
  1.  .Q:'$G(ABMP("BDFN"))
  1.  .D SET
  1.  .D ONE
  1.  .K ABMQUIT
  1.  Q
  1. ONE ;process one bill
  1.  S ABMCNT=0
  1.  D:$Y+IOSL>24 HDR
  1.  W !,$P(ABMZERO,U),?10,$P(^DPT(ABMPAT,0),U)
  1.  W ?40,$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U))
  1.  W ?55,$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),"^",2))
  1.  F  D  Q:$G(ABMQUIT)
  1.  .S ABMCNT=ABMCNT+1
  1.  .D PHY Q:$G(ABMQUIT)
  1.  .D UNIT Q:$G(ABMQUIT)
  1.  .I '$G(ABMBATCH) D NB Q:$G(ABMQUIT)
  1.  .D NBILL
  1.  .Q:'$G(DA)
  1.  .D BFILE
  1.  Q
  1. PHY ;enter physician
  1.  W !
  1.  K DIC,ABMPHY
  1.  S:ABMCNT=1 ABMPHY=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
  1.  S:ABMCNT=2 ABMPHY=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0))
  1.  S:$G(ABMPHY) ABMPHY=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPHY,0),U)
  1.  S:$G(ABMPHY) DIC("B")=$P($G(^VA(200,+$G(ABMPHY),0)),U)
  1.  S DIC="^VA(200,",DIC(0)="AEMQ"
  1.  S DIC("A")="Enter Physician: "
  1.  D ^DIC
  1.  I +Y<0 S ABMQUIT=1 Q
  1.  S ABMPHY=+Y
  1.  Q
  1. UNIT ;enter units
  1.  S X1=ABMDTT,X2=ABMDTF D ^%DTC S DIR("B")=X+1
  1.  S DIR(0)="N^1:99"
  1.  S DIR("A")="Enter # of Units: "
  1.  D ^DIR K DIR
  1.  S ABMUNIT=Y
  1.  I ABMUNIT'>0 S ABMQUIT=1
  1.  Q
  1. NB ;enter new batch in file 9002274.6
  1.  K DIC
  1.  S DIC="^ABMDTXST(DUZ(2),"
  1.  S DIC(0)="LX"
  1.  D NOW^%DTC S X=%
  1.  D ^DIC
  1.  I +Y<0 S ABMQUIT=1 Q
  1.  S ABMBATCH=+Y
  1.  S DA=ABMBATCH
  1.  S DIE=DIC
  1.  S DR=".02////"_ABMMOE_";.05////"_DUZ_";.04////"_ABMINS_";.03////"_ABMITYP
  1.  S:$P($G(^ABMDEXP(ABMMOE,1)),"^",5)="E" DR=DR_";.14////IPPHYS.NUL"
  1.  D ^DIE
  1.  Q
  1. NBILL ;create bill in bill file
  1.  K DA
  1.  D DUP I $G(ABMDUP) D  I Y'=1 Q
  1.  .W !
  1.  .W !,"A physician IP services bill already exists for this provider"
  1.  .W !,"for this visit date and patient."
  1.  .S DIR("A")="Continue"
  1.  .S DIR("B")="NO"
  1.  .S DIR(0)="Y" D ^DIR K DIR
  1.  S ABM1(.02)=131
  1.  S ABM1(.03)=$P(ABMZERO,"^",3)
  1.  S ABM1(.05)=$P(ABMZERO,"^",5)
  1.  S ABM1(.06)=ABMMOE
  1.  S ABM1(.07)=141
  1.  S ABM1(.08)=ABMINS
  1.  S ABM1(.09)="C"
  1.  S ABM1(.1)=$P(ABMZERO,"^",10)
  1.  S ABM1(.14)=DUZ
  1.  S ABM1(.15)=DT
  1.  S ABM1(.16)="A"
  1.  S ABM1(.17)=ABMBATCH
  1.  S ABM1(.21)=ABMRATE*ABMUNIT
  1.  S ABM1(.23)=ABMRATE*ABMUNIT
  1.  S ABMBDFN=$$ADD^ABMDBAD1(.ABM1)
  1.  I 'DA W !!,"Bill NOT created." Q
  1.  S ABMBNAME=$P(^ABMDBILL(DUZ(2),DA,0),U)
  1.  W !!,"Bill # ",ABMBNAME," created"
  1.  N I F I=5,6,7,8,9,11,13,17 D
  1.  .Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),I))
  1.  .M ^ABMDBILL(DUZ(2),DA,I)=^ABMDBILL(DUZ(2),ABMP("BDFN"),I)
  1.  S ^ABMDBILL(DUZ(2),DA,41,0)="^9002274.4041P^1^1"
  1.  S ^ABMDBILL(DUZ(2),DA,41,1,0)=ABMPHY_"^A"
  1. MED ;file entry under misc svcs
  1.  S ^ABMDBILL(DUZ(2),DA,43,0)="^9002274.4043P^1^1"
  1.  S ^ABMDBILL(DUZ(2),DA,43,1,0)=ABMCODE_"^"_$G(ABMRVCD)_"^"_ABMUNIT_"^"_ABMRATE_"^^"_1
  1.  S $P(^ABMDBILL(DUZ(2),DA,0),"^",4)="B",ABMAPOK=1
  1.  S DIK="^ABMDBILL(DUZ(2)," D IX1^DIK
  1.  Q
  1. BFILE ;file in 3P TX STATUS file
  1.  K DIC
  1.  S DIC(0)="LXE"
  1.  S X=ABMBNAME
  1.  S DA(1)=ABMBATCH
  1.  S DIC="^ABMDTXST(DUZ(2),DA(1),2,"
  1.  S:'$D(^ABMDTXST(DUZ(2),DA(1),2,0)) ^(0)="^9002274.61P^^"
  1.  D ^DIC
  1.  I +Y<0 W !!,*7,"Bill NOT added to 3P TX STATUS FILE",! Q
  1.  W " - added to batch # ",ABMBATCH,!
  1.  Q
  1. SET ;set some variables
  1.  S ABMZERO=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
  1.  S ABMPAT=$P(ABMZERO,"^",5)
  1.  S ABMDTF=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U),ABMDTT=$P(^(7),"^",2)
  1.  Q
  1. HDR ;screen header
  1.  W $$EN^ABMVDF("IOF")
  1.  S:'$D(ABM("EQ")) $P(ABM("EQ"),"=",80)=""
  1.  W !,"BILL #"
  1.  W ?10,"PATIENT"
  1.  W ?40,"ADMIT DATE"
  1.  W ?55,"DISCHARGE DATE"
  1.  W !,ABM("EQ"),!
  1.  Q
  1. DUP ;check for duplicate bill
  1.  K ABMDUP
  1.  N I S I=0 F  S I=$O(^ABMDBILL(DUZ(2),"D",ABMPAT,I)) Q:'I  D
  1.  .Q:$P(^ABMDBILL(DUZ(2),I,0),"^",7)'=141
  1.  .Q:$P(^ABMDBILL(DUZ(2),I,7),U)'=ABMDTF
  1.  .S ABMDPV=$P($G(^ABMDBILL(DUZ(2),I,41,1,0)),U)
  1.  .Q:ABMDPV'=ABMPHY
  1.  .Q:$P(^ABMDBILL(DUZ(2),I,0),"^",8)'=ABMINS
  1.  .S ABMDUP=1
  1.  Q