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

ABME8AMT.m

Go to the documentation of this file.
  1. ABME8AMT ; IHS/ASDST/DMJ - 837 AMT Segment
  1. ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1. ;Transaction Set Header
  1. ;
  1. ; IHS/SD/SDR - v2.5 p8 - IM13487/IM14092
  1. ; Modified to print payments
  1. ;
  1. EP(X) ;EP HERE
  1. ; x=entity identifier
  1. S ABMEIC=X
  1. K ABMREC("AMT"),ABMR("AMT")
  1. S ABME("RTYPE")="AMT"
  1. D LOOP
  1. K ABME,ABM,ABMEIC
  1. Q
  1. LOOP ;LOOP HERE
  1. F I=10:10:40 D
  1. .D @I
  1. .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))
  1. .I $G(ABMREC("AMT"))'="" S ABMREC("AMT")=ABMREC("AMT")_"*"
  1. .S ABMREC("AMT")=$G(ABMREC("AMT"))_ABMR("AMT",I)
  1. Q
  1. 10 ;segment
  1. S ABMR("AMT",10)="AMT"
  1. Q
  1. 20 ;AMT01 - Amount Qualifier Code
  1. S ABMR("AMT",20)=ABMEIC
  1. Q
  1. 30 ;AMT02 - Monetary Amount
  1. ; prior payment - actual
  1. I ABMEIC="C4"!(ABMEIC="D") D
  1. .D PAYED^ABMERUTL
  1. .S ABMR("AMT",30)=$G(ABMP("PAYED",+$G(ABMP("INS",ABMPST)))) ;pymt for that insurer
  1. ;
  1. ; payer estimated amount
  1. I ABMEIC="C5" D
  1. .D PAYED^ABMERUTL
  1. .S ABMR("AMT",30)=$P(ABMB2,U)
  1. .S ABMR("AMT",30)=ABMR("AMT",30)-$G(ABMP("PAYED"))
  1. .S ABMR("AMT",30)=ABMR("AMT",30)-$P(ABMB9,"^",9)
  1. ;
  1. ; patient paid amount
  1. I ABMEIC="F5" D
  1. .S ABMR("AMT",30)=$P(ABMB9,"^",9)
  1. ;
  1. I ABMEIC="F2" D
  1. .S ABMR("AMT",30)=ABMF2AMT
  1. ;
  1. ;start new code abm*2.6*3 HEAT7574
  1. I ABMEIC="B6" D
  1. .S ABMR("AMT",30)=ABMB6AMT
  1. ;end new code HEAT7574
  1. ;
  1. S ABMR("AMT",30)=$FN(ABMR("AMT",30),"-")
  1. S ABMR("AMT",30)=$J(ABMR("AMT",30),0,2)
  1. ;
  1. Q
  1. 40 ;AMT03 - Credit/Debit Flag Code-not used
  1. S ABMR("AMT",40)=""
  1. Q