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

ABMDE2P.m

Go to the documentation of this file. 
  1. ABMDE2P ; IHS/ASDST/DMJ - Edit Page 2 - PICK PAYER ; 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6,24,27**;NOV 12, 2009;Build 486
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - task 8
  1.  ;    Added code for replacement insurer
  1.  ;
  1.  ;IHS/SD/SDR v2.5 p9 - IM13815 - change bill type when different insurer is picked
  1.  ;
  1.  ;IHS/SD/SDR 2.6*6 NOHEAT allow a 10th insurer to be selected; if 10th was selected it was putting 1st
  1.  ;IHS/SD/SDR 2.6*24 CR9823 Added code to update fees if an insurer is Picked that has a different fee table setup than the one on the claim originally
  1.  ;IHS/SD/SDR 2.6*27 CR8894 Updated fee table change from p24 to use CPT, not CPT IEN for lookup
  1.  ; *********************************************************************
  1.  ;
  1. P1 ; Pick Insurer
  1.  W !
  1.  I $E(Y,2)>0&($E(Y,2)<(ABMZ("NUM")+1)) S Y=$E(Y,2) G P2
  1.  I ABMZ("NUM")=1 S Y=1 G P2
  1.  K DIR
  1.  S DIR(0)="NO^1:"_ABMZ("NUM")_":0"
  1.  S DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to BILL"
  1.  S DIR("A")="Sequence Number of "_ABMZ("ITEM")_" to BILL"
  1.  D ^DIR
  1.  K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y'>0)
  1.  ;
  1. P2 ;
  1.  Q:'$D(ABMZ(Y))
  1.  ;S ABM("ANS")=$E(Y)  ;abm*2.6*6 NOHEAT
  1.  S ABM("ANS")=+$G(Y)  ;abm*2.6*6 NOHEAT
  1.  I $P(ABMZ(ABM("ANS")),U,4)="U" D  Q
  1.  . W !!,*7,$P(ABMZ(ABM("ANS")),U)," is Designated as UNBILLABLE!",!
  1.  . D PAZ
  1.  I '$D(ABMZ("UNBILL",ABM("ANS"))) G PA
  1.  W !!,$P(ABMZ(ABM("ANS")),U)," has Already been Billed!"
  1.  W !
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Do you wish to bill "_$P(ABMZ(ABM("ANS")),U,1)_" Again"
  1.  D ^DIR
  1.  K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y'=1)
  1.  ;
  1. PA ;
  1.  I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)]"" D
  1.  .W !!,$P(^AUTNINS($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8),0),U)
  1.  .W " is Currently the Billing Source!"
  1.  W !
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Do you wish to bill "_$P(ABMZ(ABM("ANS")),U,1)
  1.  D ^DIR
  1.  K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y'=1)
  1.  ;
  1. P3 ;
  1.  N ABMVIST,ABMMODE
  1.  S ABMP("INS")=$P(ABMZ(ABM("ANS")),U,2)
  1.  S DA=ABMP("CDFN")
  1.  S DIE="^ABMDCLM(DUZ(2),"
  1.  S ABMVIST=$P(^ABMDCLM(DUZ(2),DA,0),U,7)
  1.  S ABMMODE=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMVIST,0)),U,4)
  1.  S DR=".08////"_ABMP("INS")_$S(ABMMODE:";.14///"_ABMMODE,1:"")
  1.  S ABMP("BTYP")=$S($P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,11)'="":$P($G(^ABMDCODE($P(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,11),0)),U),1:ABMP("VTYP"))
  1.  S DR=DR_";.12////"_ABMP("BTYP")
  1.  D ^DIE
  1.  K DR
  1.  K ^ABMDCLM(DUZ(2),DA,13,"C")
  1.  S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
  1.  S ABMX("INS")=$P(ABMZ(ABM("ANS")),"^",3)
  1.  D COV^ABMDE2X5
  1.  K ABMX
  1.  S Y="",ABM("T")=""
  1.  I ABMZ("UNBILL") D
  1.  .F ABM("I")=1:1 S ABM("T")=$O(ABMZ("UNBILL",ABM("T"))) Q:'ABM("T")  D
  1.  ..I ABM("T")'=ABM("ANS") D
  1.  ...S Y=$S(Y]"":Y_","_ABM("T"),1:ABM("T"))
  1.  S Y=$S(Y]"":Y_","_ABM("ANS"),1:ABM("ANS"))
  1.  F ABM("I")=1:1 S ABM("T")=$O(ABMZ(ABM("T"))) Q:'ABM("T")  D
  1.  .I ABM("T")'=ABM("ANS") D
  1.  ..I '$D(ABMZ("UNBILL",ABM("T"))) D
  1.  ...S Y=Y_","_ABM("T")
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIE="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
  1.  I ABM("I")'=1 D
  1.  .K ABMX
  1.  .F ABMX=1:1 S ABMX("Y")=$P(Y,",",ABMX) Q:ABMX("Y")=""  Q:+ABMX("Y")'>0!(ABMX("Y")'<(ABMZ("NUM")+1))  D
  1.  ..S:'$D(ABMX(ABMX("Y"))) ABMX(ABMX("Y"))=ABMX
  1.  I ABM("I")'=1 D
  1.  .F ABMX=1:1:ABMZ("NUM") D
  1.  ..S DA=$P(ABMZ(ABMX),U,3)
  1.  ..S DR=".02////"_$S($D(ABMX(ABMX)):ABMX(ABMX),1:ABMX)
  1.  ..D ^DIE
  1.  S DA(1)=ABMP("CDFN")
  1.  S DA=$P(ABMZ(ABM("ANS")),U,3)
  1.  S DIE="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
  1.  S DR=".03///I"
  1.  D ^DIE
  1.  K DR
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
  1.  S DR=".03///P"
  1.  S DA=0
  1.  F  S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,DA)) Q:'DA  D
  1.  .I "CU"'[$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,DA,0),U,3) D
  1.  .. I DA'=$P(ABMZ(ABM("ANS")),U,3) D ^DIE
  1.  S ABMPS("FEE")=ABMP("FEE")  ;abm*2.6*24 IHS/SD/SDR CR9823
  1.  D TPICHECK^ABMDE1
  1.  ;start new abm*2.6*24 IHS/SD/SDR CR9823
  1. NEWFETBL ;
  1.  ;if a fee table is setup for the insurer/visit type and it's not the one already defined
  1.  S ABMFTST=0
  1.  I +$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,5)'=0&(+$G(ABMPS("FEE"))'=+$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,5)) S ABMFTST=1
  1.  I ABMFTST=0&(+$P($G(^ABMDPARM(DUZ(2),1,0)),U,9)'=0)&(+$G(ABMPS("FEE"))'=+$P($G(^ABMDPARM(DUZ(2),1,0)),U,9)) S ABMFTST=1
  1.  I ABMFTST=1 D
  1.  .W !!,$$EN^ABMVDF("HIN"),"**Note**",$$EN^ABMVDF("HIF")
  1.  .W "  A different fee schedule (#"_ABMP("FEE")_") has been identified for this"
  1.  .W !,"visit type ("_ABMP("VTYP")_").",!
  1.  .D ^XBFMK
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Do you wish to import those fees into this claim"
  1.  .S DIR("B")="Yes"
  1.  .D ^DIR
  1.  .K DIR
  1.  .Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  .I Y=0 W !!,"Fees will be left as is then.." H 1 Q  ;don't want to import; leave fees as is
  1.  .S ABMI=19  ;skip everything prior to 21 (starting at 19)
  1.  .F  S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI)) Q:'ABMI!(ABMI>47)  D
  1.  ..Q:ABMI=41  ;skip provider multiple
  1.  ..S ABMTT=0
  1.  ..F  S ABMTT=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMTT)) Q:'ABMTT  D
  1.  ...I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMTT,0)),U,17)["|TC" Q  ;skip any entry that are from the V Trans Code file; these are from charge master and should be left alone
  1.  ...K ABMT
  1.  ...D ^XBFMK
  1.  ...S DA(1)=ABMP("CDFN")
  1.  ...S DA=ABMTT
  1.  ...S DIE="^ABMDCLM("_DUZ(2)_","_DA(1)_","_ABMI_","
  1.  ...;S ABMT("CD")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMTT,0)),U)  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  ...S ABMT("CD")=$P($$CPT^ABMCVAPI($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMTT,0)),U),ABMP("VDT")),U,2)  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  ...S ABMMLT=$S(ABMI=21:11,ABMI=23:25,ABMI=25:31,ABMI=27:19,ABMI=33:21,ABMI=35:15,ABMI=37:17,ABMI=39:23,ABMI=43:13,ABMI=45:32,ABMI=47:13,1:13)
  1.  ...I ABMI=33 S ABMR("CODE")=$$GET1^DIQ(9999999.31,ABMT("CD"),".01","E"),ABMT("CD")="1"_ABMR("CODE")
  1.  ...S ABMT("FEE")=+$$ONE^ABMFEAPI(ABMP("FEE"),ABMMLT,ABMT("CD"),ABMP("VDT"))
  1.  ...I ABMI=21 S DR=".07"
  1.  ...I "^23^27^35^37^39^43^47^"[("^"_ABMI_"^") S DR=".04"
  1.  ...I ABMI=25 S DR=".03"
  1.  ...I ABMI=33 S DR=".08"
  1.  ...S DR=DR_"////"_+ABMT("FEE")
  1.  ...D ^DIE
  1.  .W !!,"Updates complete" H 1
  1.  ;end new abm*2.6*24 IHS/SD/SDR CR9823
  1.  Q
  1.  ;
  1. PAZ ;
  1.  K DIR
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  K DIRUT,DUOUT
  1.  Q