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

ABMDF14C.m

Go to the documentation of this file. 
  1. ABMDF14C ; IHS/ASDST/DMJ - Set HCFA1500 Print Array ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;TMD;
  1.  ;
  1.  ; IHS/ASDS/LSL -08/01/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
  1.  ;     Don't print unbillable insurers in box 9D
  1.  ;
  1.  ; IHS/ASDS/DMJ - 01/09/02 - V2.4 Patch 10 - NOIS NFA-1201-180018
  1.  ;     Modified to correct values that were being reset in nested
  1.  ;     calls.
  1.  ;
  1.  ; IHS/SD/SDR - V2.5 P3 - 1/24/03 - NEA-0301-180044
  1.  ;     Modified to display patient info when workers comp
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - IM14272/IM15419
  1.  ;    Used billed amount for flat rate per Adrian; Due to inpt covered
  1.  ;    days, make rate=billed amount/covered days (units)
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p9 - IM15533
  1.  ;    Removed dash from Block 1A
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p9 - IM16155
  1.  ;    Patient ID# not policy holder number
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20068
  1.  ;   Fix Policy number
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20225
  1.  ;   Check for DME group number
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20752
  1.  ;   Add check for new insurer parameter regarding
  1.  ;   dash printing in block 1A
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p12 - IM23734
  1.  ;   Added change for AK Medicaid to remove blocks 9 and 11
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1.  D VAR
  1.  D LOOP
  1.  D VAR
  1.  D XIT
  1.  Q
  1. VAR S ABM("CNT")=0
  1.  S ABMP("C0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
  1.  S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
  1.  S ABMP("VDT")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U),$P(ABMP("C0"),U,2)=ABMP("VDT")
  1.  S ABMP("VTYP")=$P(ABMP("C0"),U,7)
  1.  Q
  1. LOOP S ABM("IN")="" F ABM("I")=41:1:43 S ABM("IN")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("IN"))) Q:'ABM("IN")  S ABM("XIEN")=$O(^(ABM("IN"),"")) S ABM("Z")=$S(ABM("I")=41:"A",ABM("I")=42:"B",1:"C") D INS
  1.  Q
  1.  ;
  1. XIT K ABM,ABME,ABMV
  1.  Q
  1.  ;
  1. INS Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0))  S ABM("INSCO")=$P(^(0),"^",1)
  1.  Q:$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),U,3)="U"
  1.  I ABM("INSCO")=$P(ABMP("B0"),U,8),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),"^",3)="I" D
  1.  .D ^ABMDE2X1
  1.  .I $D(ABMP("FLAT")) D
  1.  ..S $P(ABMP("FLAT"),U)=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)  ;bill amt
  1.  ..S:ABMP("VTYP")=111 $P(ABMP("FLAT"),U)=$P(ABMP("FLAT"),U)/$P(ABMP("FLAT"),U,3)
  1.  .S ABMP("EXP")=14
  1. PAYOR S Y=ABM("INSCO") D SEL^ABMDE2X
  1.  S ABM("I0")=+ABMV("X1")
  1.  I ABM("INSCO")'=$P(ABMP("B0"),U,8),ABM("CNT")=0,"IN"'[$P($G(^AUTNINS(ABM("I0"),2)),U) D
  1.  .Q:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0)),U,11)=$P(ABMP("B0"),U,8)
  1.  .Q:$P($G(^AUTNINS(ABMP("INS"),0)),U)="ALASKA MEDICAID"  ;skip fl9 and 11 if AK Mcd
  1.  .S $P(ABMF(19),U,3)="X",$P(ABMF(19),U,4)=""
  1.  .S $P(ABMF(19),U)=$P(^AUTNINS(ABM("I0"),0),U)
  1.  .S $P(ABMF(11),U)=$P($P(ABMV("X2"),U),";",2)
  1.  .S $P(ABMF(15),U)=$P(ABMV("X2"),U,7)
  1.  .I $P(ABMV("X2"),U,6)]"" S $P(ABMF(15),U,$S($P(ABMV("X2"),U,6)="F":3,1:2))="X"
  1.  .S $P(ABMF(13),U)=$P(ABMV("X1"),U,4)_"  "_$P(ABMV("X3"),U,7)
  1.  .S $P(ABMF(17),U)=$P(ABMV("X3"),U)
  1.  .S ABM("CNT")=ABM("CNT")+1
  1. PRIM ;
  1.  I ((ABM("INSCO")=$P(ABMP("B0"),U,8))!($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0)),U,11)=$P(ABMP("B0"),U,8))),($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM("XIEN"),0),"^",3)="I") D
  1.  .S ABM("SPOUSE")=0
  1.  .I $P(^AUPNPAT(ABMP("PDFN"),0),U,22) S ABM("SPOUSE")=1
  1.  .I $P($G(^AUPNPAT(ABMP("PDFN"),28)),U,2),$P($G(^AUTTRLSH($P(^(28),U,2),0)),U,3)="02" S ABM("SPOUSE")=1
  1.  .I $P($G(^AUPNPAT(ABMP("PDFN"),31)),U,2),$P($G(^AUTTRLSH($P(^(31),U,2),0)),U,3)="02" S ABM("SPOUSE")=1
  1.  .I $P(ABMV("X2"),U,2),$P($G(^AUTTRLSH(+$P(ABMV("X2"),U,2),0)),U,3)="02" S ABM("SPOUSE")=1
  1.  .S ABMPIECE=3
  1.  .S:ABM("SPOUSE") ABMPIECE=4
  1.  .S ABMMSTAT=$P(^DPT(ABMP("PDFN"),0),"^",5)
  1.  .I ABMMSTAT D
  1.  ..S ABMPIECE=5
  1.  ..S:ABMMSTAT=8 ABMPIECE=3
  1.  ..S:ABMMSTAT=2 ABMPIECE=4
  1.  .S $P(ABMF(7),"^",ABMPIECE)="X"
  1.  .S:$P($G(ABMF(19)),U,3)="" $P(ABMF(19),U,4)="X"
  1.  .S $P(ABMF(3),U,5)=$P($P(ABMV("X2"),U),";",2)
  1.  .I $P(ABMV("X3"),U,1)]"",$P(ABMV("X3"),U,6)]"" S ABMF(1)="",$P(ABMF(1),U,5)="X"
  1.  .S $P(ABMF(1),U,8)=$S($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,8):$P(^(4),U,8),$P($G(ABMV("X1")),U,12)'="":$P(ABMV("X1"),U,12),1:$P(ABMV("X1"),U,4))
  1.  .I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,7)="N" S $P(ABMF(1),U,8)=$TR($P(ABMF(1),U,8),"-","")
  1.  .S $P(ABMF(15),U,7)=$P(ABMV("X3"),U,1)
  1.  .S $P(ABMF(17),U,4)=$P($P(ABMV("X1"),U),";",2)
  1.  .S $P(ABMF(11),U,2)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,3)  ;group name/number
  1.  .I $P(ABMF(11),U,2)="",($P(ABMV("X3"),U,7)]"") S $P(ABMF(11),U,2)=$P(ABMV("X3"),U,7)_"/"_$P(ABMV("X3"),U,6)
  1.  .S $P(ABMF(13),U,4)=$P(ABMV("X2"),U,7)
  1.  .I $P(ABMV("X2"),U,6)]"" S $P(ABMF(13),U,$S($P(ABMV("X2"),U,6)="F":6,1:5))="X"
  1.  .S $P(ABMF(5),U,6)=$P(ABMV("X2"),U,3)
  1.  .S $P(ABMF(7),U,6)=$P($P(ABMV("X2"),U,4),", ")
  1.  .S $P(ABMF(7),U,7)=$P($P($P(ABMV("X2"),U,4),", ",2),"  ")
  1.  .S $P(ABMF(9),U,6)=$P($P($P(ABMV("X2"),U,4),", ",2),"  ",2)
  1.  .S $P(ABMF(9),U,7)=$S($E($P(ABMV("X2"),U,5))="(":"",1:" ")_$P(ABMV("X2"),U,5)
  1.  .S ABM("RLSH")=$S($P(ABMV("X2"),U,2)]"":+$P($G(^AUTTRLSH(+$P(ABMV("X2"),U,2),0)),U,2),1:"")
  1.  .I ABM("RLSH")>0&(ABM("RLSH")<4) S ABM("RLSH")=ABM("RLSH")+1
  1.  .E  S ABM("RLSH")=$S(ABM("RLSH")=5:4,1:5)
  1.  .S $P(ABMF(5),U,ABM("RLSH"))="X"
  1.  Q