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

ABMASPLT.m

Go to the documentation of this file. 
  1. ABMASPLT ; IHS/SD/SDR - Auto-Split check ;     
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/SD/SDR - V2.5 P8 - task 8
  1.  ;   new routine for auto-splitting of claims
  1.  ;
  1. MAIN(ABMCDFN) ;EP - Check if replacement and auto-split
  1.  Q:+$G(ABMAINS)=0
  1.  D REPLACE  ;replace active insurer
  1.  D SPLIT  ;split into multiple bills
  1.  Q
  1. REPLACE ;
  1.  S ABMAINS=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8)  ;active insurer
  1.  S ABMVTYP=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,7)  ;visit type
  1.  S ABMVTE=$G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,0))
  1.  Q:ABMVTE=""  ;visit type isn't set up for insurer
  1.  Q:$O(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,0))=0  ;no replacement entry
  1.  S ABMENC=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8)  ;encounter/service date?
  1.  ;find which entry in insurer multiple is the active insurer
  1.  S ABMINSI=0,ABMRPFLG=0
  1.  F  S ABMINSI=$O(^ABMDCLM(DUZ(2),ABMCDFN,13,ABMINSI)) Q:+ABMINSI=0  D  Q:$G(ABMRPFLG)=1
  1.  .S:(ABMAINS=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,13,ABMINSI,0)),U)) ABMRPFLG=1
  1.  ; a replacement exists; now let's see if there's an active one
  1.  ;S ABMVTEDT="",ABMVFLG=0
  1.  S ABMVTEDT=ABMENC+1,ABMVFLG=0
  1.  F  S ABMVTEDT=$O(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,"B",ABMVTEDT),-1) Q:ABMVTEDT=""  D  Q:ABMVFLG=1
  1.  .S ABMVIEN=0
  1.  .F  S ABMVIEN=$O(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,"B",ABMVTEDT,ABMVIEN)) Q:ABMVIEN=""  D  Q:ABMVFLG=1
  1.  ..I $$ISACTIVE($P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U),$P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,2),ABMENC) S ABMVFLG=1
  1.  Q:ABMVFLG=0  ;no active replacement--quit
  1.  ;change active insurer
  1.  K DA,DIE,DR,DIC,DD,DO
  1.  S DA=ABMP("CDFN")
  1.  S DIE="^ABMDCLM(DUZ(2),"
  1.  S DR=".08////"_$P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,3)
  1.  D ^DIE
  1.  S ABMPINS=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,8)  ;active insurer
  1.  ;stuff replacenment insurer
  1.  K DA,DIE,DR,DIC,DD,DO
  1.  S DA(1)=ABMCDFN
  1.  S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
  1.  S DA=ABMINSI
  1.  S DR=".011////"_$P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,3)
  1.  D ^DIE
  1.  ;
  1.  ;change visit type - need a new field called 'replacement visit type" ?
  1.  K DA,DIE,DR,DIC,DD,DO
  1.  S DA=ABMP("CDFN")
  1.  S DIE="^ABMDCLM(DUZ(2),"
  1.  S DR=".07////"_$P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,12,ABMVIEN,0)),U,4)
  1.  D ^DIE
  1.  Q
  1.  ;now do splitting if auto-split is YES
  1. SPLIT ;
  1.  I $P($G(^ABMNINS(DUZ(2),ABMAINS,1,ABMVTYP,0)),U,23)="Y" D
  1.  .S ABMVFL=0
  1.  .F  S ABMVFL=$O(^ABMDVTYP(ABMVTYP,2,ABMVFL)) Q:+ABMVFL=0  D
  1.  ..S ABMVFLN=$P($G(^ABMDVTYP(ABMVTYP,2,ABMVFL,0)),U)
  1.  ..K ABMMULT
  1.  ..S:ABMVFLN="8A" ABMMULT=27
  1.  ..S:ABMVFLN="8B" ABMMULT=21
  1.  ..S:ABMVFLN="8C" ABMMULT=25
  1.  ..S:ABMVFLN="8D" ABMMULT=23
  1.  ..S:ABMVFLN="8E" ABMMULT=37
  1.  ..S:ABMVFLN="8F" ABMMULT=35
  1.  ..S:ABMVFLN="8G" ABMMULT=39
  1.  ..S:ABMVFLN="8H" ABMMULT=43
  1.  ..S:ABMVFLN="8I" ABMMULT=33
  1.  ..S:ABMVFLN="8J" ABMMULT=45
  1.  ..I $O(^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT,0))="" Q  ;no entry for multiple on this claim
  1.  ..S X=$P($G(^ABMDCLM(DUZ(2),ABMCDFN,0)),U,1)
  1.  ..Q:'X
  1.  ..K DIC,DA,DR,DIE
  1.  ..S DINUM=$$NXNM^ABMDUTL
  1.  ..Q:DINUM=""
  1.  ..S DIC="^ABMDCLM(DUZ(2),"
  1.  ..S DIC(0)="L"
  1.  ..K DD,DO
  1.  ..D FILE^DICN
  1.  ..Q:+Y<0
  1.  ..S ABMC2=+Y
  1.  ..; standard data for all claims
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,0)=^ABMDCLM(DUZ(2),ABMCDFN,0)
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,4)=^ABMDCLM(DUZ(2),ABMCDFN,4)
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,5)=^ABMDCLM(DUZ(2),ABMCDFN,5)
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,6)=^ABMDCLM(DUZ(2),ABMCDFN,6)
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,7)=^ABMDCLM(DUZ(2),ABMCDFN,7)
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,8)=^ABMDCLM(DUZ(2),ABMCDFN,8)
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,9)=^ABMDCLM(DUZ(2),ABMCDFN,9)
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,10)=^ABMDCLM(DUZ(2),ABMCDFN,10)
  1.  ..;
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,11)=^ABMDCLM(DUZ(2),ABMCDFN,11)  ;pcc visits
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,13)=^ABMDCLM(DUZ(2),ABMCDFN,13)  ;insurers
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,17)=^ABMDCLM(DUZ(2),ABMCDFN,17)  ;icds
  1.  ..M ^ABMDCLM(DUZ(2),ABMC2,41)=^ABMDCLM(DUZ(2),ABMCDFN,41)  ;providers
  1.  ..;the specified multiple to be split
  1.  ..I $G(ABMMULT)'="" D
  1.  ...M ^ABMDCLM(DUZ(2),ABMC2,ABMMULT)=^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT)
  1.  ...;should multiple be removed from original claim?
  1.  ...I $P($G(^ABMDVTYP(ABMVTYP,2,ABMVFL,0)),U,2)="Y" D
  1.  ....K DA
  1.  ....S DA=0,DA(1)=ABMCDFN
  1.  ....F  S DA=$O(^ABMDCLM(DUZ(2),ABMCDFN,ABMMULT,DA)) Q:+DA=0  D
  1.  .....S DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMMULT_","
  1.  .....D ^DIK
  1.  ..I $G(ABMMULT)="" M ^ABMDCLM(DUZ(2),ABMC2)=^ABMDCLM(DUZ(2),ABMCDFN)
  1.  Q
  1.  ;GIVEN A ENCOUNTER/SERVICE DATE AND BEGIN/END DATES OF REPLACEMENT INSURER
  1.  ;WHICH REPLACEMENT INSURER IS ACTIVE. NOTE: THERE SHOULD NOT BE MORE THAN ONE
  1.  ;REPLACEMENT INSURER ACTIVE FOR ANY GIVEN DATE
  1. ISACTIVE(EFFDT,ENDDT,TARDATE) ;
  1.  NEW OPENEND
  1.  I EFFDT="",(ENDDT="") Q 0
  1.  S ENDDT=ENDDT  ;TRUE IF ENDING DATE IS AT COB OF ENDING DATE - ANSWER FROM ADRIAN IS IT IS
  1.  ;               IN FORCE FOR ALL OF TODAY
  1.  S OPENEND=ENDDT=""
  1.  I OPENEND I TARDATE=EFFDT!(TARDATE>EFFDT) Q 1
  1.  I TARDATE=EFFDT!(TARDATE=ENDDT) Q 1
  1.  I TARDATE>EFFDT&(TARDATE<ENDDT) Q 1
  1.  Q 0