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

ABMDFUTL.m

Go to the documentation of this file. 
  1. ABMDFUTL ; IHS/SD/DMJ - Export Forms Utility ;     
  1.  ;;2.6;IHS Third Party Billing System;**2,6,8,9,10,13,14,21**;NOV 12, 2009;Build 379
  1.  ;Original;TMD;
  1.  ;
  1.  ; IHS/ASDS/DMJ - 05/15/00 - V2.4 Patch 1 - NOIS HQW-0500-100032 - Modified to allow population of the PIN number for KIDSCARE
  1.  ;     as well as visit type 999.
  1.  ; IHS/ASDS/SDH - 08/14/01 - V2.4 Patch 9 - NOIS NDA-1199-180065 - Modified routine to get grouper allowance, non-covered, and penalties.
  1.  ; IHS/ASDS/SDH - 11/20/01 - V2.4. Patch 10 - NOIS QXX-1101-130059 - Modified to get billed amount even if there are no payments
  1.  ;
  1.  ; IHS/SD/SDR - 10/10/02 V2.5 P2 - NGA-0902-180106 - Modified to put provider number in 24k if Medicare/Railroad insurer
  1.  ;IHS/SD/SDR - V2.5 P8 - IM10618/IM11164 - utility to return provider for line item
  1.  ;IHS/SD/SDR - v2.5 p11 - NPI
  1.  ;IHS/SD/SDR - v2.5 p12 - IM24799 - Made change for <UNDEF>K24N+9^ABMDFUTL
  1.  ;IHS/SD/SDR - v2.5 p12 - IM25017 - Made changes for 1st line of block 24J
  1.  ;IHS/SD/SDR - v2.5 p13 - IM26203 - Print loc NPI in block 33A
  1.  ;IHS/SD/SDR - v2.5 p13 - IM26299 - Fix if insurer type is <UNDEF>
  1.  ;IHS/SD/SDR - v2.5 p13 - NO IM - Change to use LDFN instead of DUZ(2)
  1.  ;
  1.  ;IHS/SD/SDR - abm*2.6*2 - HEAT10900 - ck if Medicare and primary
  1.  ;IHS/SD/SDR - 2.6*9 - HEAT46390 - fixed writeoff amount to include all bills
  1.  ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35; Also added lookup for provider
  1.  ;IHS/SD/SDR - 2.6*14 - HEAT163697 - changed message in provider lookup if provider is not in New Person file; Also updated lookup so it wouldn't allow special characters if name
  1.  ;  is not in New Person file.
  1.  ;IHS/SD/SDR - 2.6*14 - HEAT165324 - Fixed NPI for PRVLKUP so it will force NPI to be numeric; displays message and prompts again if not
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT196358 - For page 3 question Ord/Ref/Sup Phys (FL17), made change so no NPI can be entered but if none is
  1.  ;   entered, the name that was entered won't be saved either. 
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. TXST ;EP for obtaining or adding 3P TX STATUS entry
  1.  ;    - input variables: ABMP("EXP") - export form
  1.  ;                       ABMY("INS") - insurer      (optional)
  1.  ;                       ABMY("TYP") - insurer type (optional)
  1.  ;    - output variable: ABMP("XMIT") - export batch
  1.  ;
  1.  N ABMX
  1.  S ABMX="",ABMP("XMIT")=0
  1.  F  S ABMX=$O(^ABMDTXST(DUZ(2),"B",DT,ABMX)) Q:'ABMX  D  Q:ABMP("XMIT")
  1.  .Q:'$D(^ABMDTXST(DUZ(2),ABMX,0))  Q:$P(^(0),U,2)'=ABMP("EXP")
  1.  .I $D(ABMY("TYP")),$P(^ABMDTXST(DUZ(2),ABMX,0),U,3)=ABMY("TYP") S ABMP("XMIT")=ABMX
  1.  .I $D(ABMY("INS")),$P(^ABMDTXST(DUZ(2),ABMX,0),U,4)=ABMY("INS") S ABMP("XMIT")=ABMX
  1.  Q:ABMP("XMIT")
  1.  S DIC="^ABMDTXST(DUZ(2),",DIC(0)="L",X=DT
  1.  S DIC("DR")=".02////"_ABMP("EXP")_";.07////1;.08////1;"_$S($D(ABMY("TYP")):".03////"_$P(ABMY("TYP"),U),$D(ABMY("INS")):".04////"_ABMY("INS"),1:".03////A")_";.05////"_DUZ
  1.  K DD,DO,DINUM D FILE^DICN S:Y>0 ABMP("XMIT")=+Y
  1.  Q
  1.  ;
  1. YTOT ;EP for updating ABMY("TOT") variable
  1.  ;    - input variables: ABM("YTOT") = $ amount of each bill
  1.  ;    - output variable: ABMY("TOT") = # bills ^ $ amount ^ # insurers
  1.  ;
  1.  S $P(ABMY("TOT"),U)=$P($G(ABMY("TOT")),U)+1
  1.  S $P(ABMY("TOT"),U,2)=$P(ABMY("TOT"),U,2)+$G(ABM("YTOT"))
  1.  I '$D(ABMY("TINS",$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8))) S ABMY("TINS",$P(^(0),U,8))="",$P(ABMY("TOT"),U,3)=$P(ABMY("TOT"),U,3)+1
  1.  Q
  1.  ;
  1. WTOT ;EP for writing Summary totals
  1.  Q:$D(ZTQUEUED)
  1.  W !!?16,"(All Print-outs are Complete)"
  1.  I $G(ABMP("XMIT")) W !!?5,"For Printing Mailing Labels, Worksheets or a Transmittal Listing...",!?5,"...refer to EXPORT BATCH: ",ABMP("XMIT") D
  1.  .S:'$D(ABMY("TOT")) ABMY("TOT")="0^0^0"
  1.  W !?17,"==========================="
  1.  W !?17,"Number of Records Exported: ",$P(ABMY("TOT"),U)
  1.  W !?17,"Number of Insurers........: ",$P(ABMY("TOT"),U,3)
  1.  W !?17,"Total Amount Billed.......: ",$FN($P(ABMY("TOT"),U,2),",",2),!
  1.  K DIR S DIR(0)="E" D ^DIR K DIR
  1.  Q
  1.  ;
  1. TXUPDT ;EP for updating the TXST file
  1.  Q:'ABMP("XMIT")
  1.  S DA=ABMP("XMIT")
  1.  Q:'$D(^ABMDTXST(DUZ(2),ABMP("XMIT"),0))  S ABM(0)=^(0),ABM(1)=$G(^(1))
  1.  S DIE="^ABMDTXST(DUZ(2),"
  1.  S DR=".09////"_(ABMY("TOT")+$P(ABM(0),U,9))_";.11////"_($P(ABMY("TOT"),U,2)+ABM(1))_";.12////"_($P(ABMY("TOT"),U,3)+$P(ABM(1),U,2))
  1.  D ^ABMDDIE
  1.  Q
  1.  ;
  1. PREV ;EP for obtaining previous payment info
  1.  ;
  1.  ; output vars: ABMP("PD") - amount of payments
  1.  ;              ABMP("WO") - amount of write-offs
  1.  ;
  1.  S (ABMP("GRP"),ABMP("NONC"),ABMP("PENS"),ABMP("COI"),ABMP("DED"),ABMP("REF"))=0
  1.  K ABMP("BILL")
  1.  N ABM
  1.  I $D(ABMPM) M ABMP=ABMPM K ABMPM Q
  1.  S (ABMP("PD"),ABMP("WO"))=0
  1.  S ABM("W")=0  ;abm*2.6*9 HEAT46390
  1.  I $G(ABMAFLG)=1,($G(ABMMFLG)=1),(ABMP("EXP")>30) Q  ;treat as primary if tribal self insured and Medicare  ;abm*2.6*10 COB billing
  1.  S ABM("CLM")=$S($G(ABMP("BDFN")):+$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U),1:ABMP("CDFN"))
  1.  S ABM("BIL")=$S($G(ABMP("BDFN")):ABMP("BDFN"),1:0)
  1.  S ABM("A")="" F  S ABM("A")=$O(^ABMDBILL(DUZ(2),"AS",ABM("CLM"),ABM("A"))) Q:ABM("A")=""  D
  1.  .F ABM=0:0 S ABM=$O(^ABMDBILL(DUZ(2),"AS",ABM("CLM"),ABM("A"),ABM)) Q:'ABM  D
  1.  ..Q:$D(ABM(ABM))
  1.  ..Q:$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,5)'=ABMP("PDFN")
  1.  ..Q:$P($G(^ABMDBILL(DUZ(2),ABM,0)),"^",4)="X"
  1.  ..;Q:($P($G(^AUTNINS(ABMP("INS"),2)),U)="R")  ;abm*2.6*2 HEAT10900
  1.  ..;Q:(($P($G(^AUTNINS(ABMP("INS"),2)),U)="R")&($G(ABMR("SBR",30))="P"))  ;abm*2.6*2 HEAT10900  ;abm*2.6*10 HEAT73780
  1.  ..Q:(($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R")&($G(ABMR("SBR",30))="P"))  ;abm*2.6*2 HEAT10900  ;abm*2.6*10 HEAT73780
  1.  ..;S ABM("W")=0,ABM(ABM)=""  ;abm*2.6*9 HEAT46390
  1.  ..S ABM(ABM)=""  ;abm*2.6*9 HEAT46390
  1.  ..F ABM("J")=0:0 S ABM("J")=$O(^ABMDBILL(DUZ(2),ABM,3,ABM("J"))) Q:'ABM("J")  D
  1.  ...S ABMP("PD")=$P(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0),U,2)+ABMP("PD"),ABM("W")=ABM("W")+$P(^(0),U,6)
  1.  ...;S ABMP("WO")=ABM("W")  ;abm*2.6*9 HEAT46390
  1.  ...S ABMP("GRP")=$P($G(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0)),U,12)
  1.  ...;S ABMP("NONC")=$P($G(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0)),U,7)  ;abm*2.6*9 HEAT46390
  1.  ...S ABMP("NONC")=ABMP("NONC")+$P($G(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0)),U,7)  ;abm*2.6*9 HEAT46390
  1.  ...S ABMP("PENS")=$P($G(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0)),U,9)
  1.  ...S ABMP("COI")=$P($G(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0)),U,4)
  1.  ...S ABMP("DED")=$P($G(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0)),U,3)
  1.  ...S ABMP("REF")=$P($G(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0)),U,13)
  1.  ...;S ABMP("WO")=ABMP("WO")+ABM("W")+ABMP("GRP")+ABMP("NONC")+ABMP("PENS")  ;abm*2.6*9 HEAT46390
  1.  ..I $D(ABMP("BDFN")) S ABMP("BILL")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)
  1.  ..I $P($G(^ABMDBILL(DUZ(2),ABM,2)),U,4)=0 S ABMP("WO")=ABMP("WO")+ABM("W")
  1.  Q
  1. GETPRV() ;EP - get attending or rendering provider for line
  1.  ; item if not one on indiv. page
  1.  I $G(ABMP("GL"))="" Q 0
  1.  S ABMPRV=0
  1.  ;S ABMPRVT=ABMP("GL")_"41,"_"""C"""_","_"""A"""_","_"0)"  ;abm*2.6*6 NOHEAT
  1.  S ABMPRVT=ABMP("GL")_"41,"_"""C"",""A"",0)"  ;abm*2.6*6 NOHEAT
  1.  S ABMPRV=$O(@ABMPRVT)
  1.  ;I ABMPRV="" S ABMPRVT=ABMP("GL")_"41,""C"",""R"","_"0)",ABMPRV=$O(@ABMPRVT)  ;abm*2.6*6 NOHEAT
  1.  I ABMPRV="" S ABMPRVT=ABMP("GL")_"41,""C"",""R"",0)",ABMPRV=$O(@ABMPRVT)  ;abm*2.6*6 NOHEAT
  1.  S ABMPRVT=ABMP("GL")_"41,"_ABMPRV_",0)"
  1.  S ABMPRVT=$P(@ABMPRVT,"^")
  1.  Q ABMPRVT
  1. K24() ;EP - box 24k hcfa form
  1.  ;start old code abm*2.6*13 export mode 35
  1.  ;I $G(ABMP("EXP"))'=27,($P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0)),"^",15)="MD") Q 1
  1.  ;I $G(ABMP("EXP"))=27 Q 1
  1.  ;end old code start new code export mode 35
  1.  I ($G(ABMP("EXP"))'=27&(ABMP("EXP")'=35)),($P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0)),"^",15)="MD") Q 1
  1.  I $G(ABMP("EXP"))=27!(ABMP("EXP")=35) Q 1
  1.  ;end new code export mode 35
  1.  Q 0
  1. K24N(X) ;EP - get payer assigned number (x=provider file 200 ien)
  1.  N Y
  1.  I '$G(ABMP("BDFN")) S Y="" Q Y
  1.  I '$G(ABMP("INS")) S Y="" Q Y
  1.  S Y=$P($G(^VA(200,+X,9999999.18,ABMP("INS"),0)),"^",2)
  1.  I Y=""&($G(ABMP("VTYP"))=999)&($P($G(^AUTNINS(ABMP("INS"),0)),U)="OKLAHOMA MEDICAID") S Y=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,X,0)),U,2)
  1.  I $P($G(^AUTNINS(ABMP("INS"),0)),U)["MEDICARE"!($P($G(^AUTNINS(ABMP("INS"),0)),U)["RAILROAD")!($P($G(^AUTNINS(ABMP("INS"),0)),U)["BLUE") D
  1.  .;I $G(ABMP("EXP"))=27 D  ;abm*2.6*13 export mode 35
  1.  .I $G(ABMP("EXP"))=27!(ABMP("EXP")=35) D  ;abm*2.6*13 export mode 35
  1.  ..S:+$G(ABMDUZ2)=0 ABMDUZ2=DUZ(2)
  1.  ..S ABMPQ=$S(ABMP("ITYPE")="R":"1C"_" ",ABMP("ITYPE")="D":"1D"_" ",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B"_" ")
  1.  .S Y=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),3,X,0)),U,2)
  1.  ;I $G(ABMP("EXP"))=27 D  ;abm*2.6*13 export mode 35
  1.  I $G(ABMP("EXP"))=27!(ABMP("EXP")=35) D  ;abm*2.6*13 export mode 35
  1.  .S:+$G(ABMDUZ2)=0 ABMDUZ2=DUZ(2)
  1.  .S ABMPQ=$S(ABMP("ITYPE")="R":"1C"_" ",ABMP("ITYPE")="D":"1D"_" ",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B"_" ")
  1.  I $G(ABMP("ITYPE"))'="",($G(ABMP("ITYPE"))'="R"),($G(ABMP("ITYPE"))'="D"),($G(ABMP("ITYPE"))'="K") D
  1.  .S ABMIDCD=""
  1.  .D PIREFID^ABME8L2
  1.  .S:$G(ABMPQ)="" ABMPQ=ABMIDCD
  1.  S:$G(ABMPQ)="" ABMPQ="G2"
  1.  ;S Y=$S(ABMP("EXP")=27&($G(Y)'=""):$G(ABMPQ),1:"")_Y K ABMPQ  ;abm*2.6*8 HEAT31586
  1.  Q Y
  1. F54() ;EP - flag 54 HCFA BOX 33
  1.  I $G(ABMP("ITYPE"))="K" Q 1
  1.  I $G(ABMP("VTYP"))=999 Q 1
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 Q 1
  1.  Q 0
  1.  ;start new code abm*2.6*13 export mode 35
  1. PRVLKUP(ABMX,ABMY) ;EP
  1.  ;user will be prompted for name; if found in New Person file, it will retrieve NPI.  If not found,
  1.  ;user will be prompted for NPI as well
  1.  N DIC,DIE,DIR,X,Y,DR,DA
  1.  S DIR(0)="FAO^2:30^D NAME^AUPNPED"
  1.  S DIR("A")="Enter Provider Name: "
  1.  I ABMX'="" S DIR("B")=ABMX
  1.  D ^DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ""
  1.  I Y="" Q ""
  1.  S ABM("PROVIDER")=Y
  1.  N DIC,DIE,DIR,X,Y,DR,DA
  1.  S DIC="^VA(200,"
  1.  S DIC(0)="EQM"
  1.  S DIC("S")="I $D(^(""PS""))"
  1.  S X=ABM("PROVIDER")
  1.  D ^DIC
  1.  I Y>0  D  Q ABM("PROVIDER")
  1.  .S $P(ABM("PROVIDER"),U)=$P(Y,U,2)
  1.  .S $P(ABM("PROVIDER"),U,2)=$S($P($$NPI^XUSNPI("Individual_ID",+Y),U)>0:$P($$NPI^XUSNPI("Individual_ID",+Y),U),1:"")
  1.  S ABMNFLG=1  ;abm*2.6*21 IHS/SD/SDR HEAT196358
  1. NPI ;
  1.  I +$G(ABMNFLG)=0  K ABM("PROVIDER") Q 0  ;if no NPI when it gets here from below quit  ;abm*2.6*21 IHS/SD/SDR HEAT196358
  1.  ;I Y<0 D  ;abm*2.6*14 HEAT165324
  1.  I +$G(Y)<1 D  ;abm*2.6*14 HEAT165324
  1.  .;W " Name not in New Person file"  ;abm*2.6*14 HEAT163697
  1.  .W " Entry NOT found"  ;abm*2.6*14 HEAT163697
  1.  .N DIC,DIE,DIR,X,Y,DR,DA
  1.  .;S DIR(0)="FA^10:10"  ;abm*2.6*14 HEAT163697
  1.  .S DIR(0)="FO^10:10"  ;abm*2.6*14 HEAT163697
  1.  .;S DIR("A")="Enter Provider NPI: "  ;abm*2.6*14 HEAT163697
  1.  .S DIR("A")="Enter Provider NPI"  ;abm*2.6*14 HEAT163697
  1.  .I ABM("PROVIDER")=ABMX,ABMY'="" S DIR("B")=ABMY
  1.  .;S DIR("S")="I $$CHKDGT^XUSNPI(X))"  ;abm*2.6*14 HEAT165324
  1.  .D ^DIR
  1.  .;start new abm*2.6*14 HEAT165324
  1.  .I Y="" W !,"No NPI entered - nothing saved" S ABMNFLG=0 S ABM("PROVIDER")="" H 1 Q  ;abm*2.6*21 IHS/SD/SDR HEAT196358
  1.  .I +$$CHKDGT^XUSNPI(Y)'=1 D  G NPI
  1.  ..W !,"NPI must be 10 numeric characters"
  1.  ..K Y
  1.  .;end new HEAT165324
  1.  .S $P(ABM("PROVIDER"),U,2)=Y
  1.  Q ABM("PROVIDER")
  1.  ;end new code export mode 35