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

ABME5L5.m

Go to the documentation of this file.
  1. ABME5L5 ; IHS/ASDST/DMJ - Header
  1. ;;2.6;IHS Third Party Billing;**6,8,9,14,21**;NOV 12, 2009;Build 379
  1. ;Header Segments
  1. ;IHS/SD/SDR - 2.6*21 - HEAT135923 - Print DTP*435 if date and bill type is 181
  1. ;
  1. START ;START HERE
  1. S ABMLOOP=2300
  1. D ^ABME5CLM
  1. D WR^ABMUTL8("CLM")
  1. I $P(ABMB6,U,4)'="",($E(ABMP("BTYP"),1,2)=11) D
  1. .D EP^ABME5DTP("096","TM",$P(ABMB6,U,4))
  1. .D WR^ABMUTL8("DTP")
  1. D EP^ABME5DTP(434,"RD8",$P(ABMB7,U),$P(ABMB7,U,2))
  1. D WR^ABMUTL8("DTP")
  1. ;I $P(ABMB6,U),($E(ABMP("BTYP"),1,2)=11) D ;abm*2.6*21 IHS/SD/SDR HEAT135923
  1. I $P(ABMB6,U),(($E(ABMP("BTYP"),1,2)=11)!(ABMP("BTYP")=181)) D ;abm*2.6*21 IHS/SD/SDR HEAT135923
  1. .D EP^ABME5DTP(435,"DT",$TR($P(ABMB6,U,1,2),U,"."))
  1. .D WR^ABMUTL8("DTP")
  1. I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,11)'="" D
  1. .D ^ABME5CN1
  1. .D WR^ABMUTL8("CN1")
  1. S ABMB5TR=$P(ABMB5,U,1,3)
  1. S ABMB5TR=$TR(ABMB5TR,U)
  1. I +ABMB5TR D
  1. .D ^ABME5CL1
  1. .D WR^ABMUTL8("CL1")
  1. I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),71)) D
  1. .K ABM71CNT
  1. .S ABM71IEN=0
  1. .F S ABM71IEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN)) Q:+ABM71IEN=0 D Q:$G(ABM71CNT)=10
  1. ..D ^ABME5PWK,WR^ABMUTL8("PWK")
  1. ..S ABM71CNT=+$G(ABM71CNT)+1
  1. I $P(ABMB9,U,9) D
  1. .D EP^ABME5AMT("F5")
  1. .D WR^ABMUTL8("AMT")
  1. I $P(ABMB4,U,9)'="" D
  1. .D EP^ABME5REF("F8")
  1. .D WR^ABMUTL8("REF")
  1. I $P(ABMB5,U,8)'="" D
  1. .D EP^ABME5REF("G4")
  1. .D WR^ABMUTL8("REF")
  1. I $P(ABMB5,U,11)'="" D
  1. .D EP^ABME5REF("9F")
  1. .D WR^ABMUTL8("REF")
  1. I $P(ABMB5,U,12)'="" D
  1. .D EP^ABME5REF("G1")
  1. .D WR^ABMUTL8("REF")
  1. ;auto accident state
  1. I $P(ABMB8,U,16)'="" D
  1. .D EP^ABME5REF("LU")
  1. .D WR^ABMUTL8("REF")
  1. D EP^ABME5REF("EA")
  1. D WR^ABMUTL8("REF")
  1. ;start old code abm*2.6*9 HEAT57041
  1. ;I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) D
  1. ;.D EP^ABME5K3
  1. ;.D WR^ABMUTL8("K3")
  1. ;end old code abm*2.6*9
  1. I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61)) D
  1. .D EP^ABME5NTE("ADD")
  1. .Q:$TR($G(ABMR("NTE",30))," ")=""
  1. .D WR^ABMUTL8("NTE")
  1. ;EPSDT Referral
  1. I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0)) D
  1. .S ABMSPIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))
  1. .Q:+ABMSPIEN=0
  1. .Q:$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,ABMSPIEN,0)),U,2)=""
  1. .D EP^ABME5CRC("EPSDT")
  1. .D WR^ABMUTL8("CRC")
  1. Q