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

ABMRDNY2.m

Go to the documentation of this file. 
  1. ABMRDNY2 ; IHS/SD/SDR - Comma-Delimited Record ;
  1.  ;;2.6;IHS Third Party Billing;**21**;NOV 12, 2009;Build 379
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT241429 - New Report
  1.  ;
  1. PRINT ;EP for printing data
  1.  D OPEN^%ZISH("ABMF",ABM("RPATH"),ABM("RFN"),"W")
  1.  Q:POP
  1.  U IO
  1.  S ABM("TXT")=""
  1.  D HDB
  1.  S (ABM("CNT"),ABM("SUBCNT"))=0
  1.  S ABM("PRV")=""
  1.  S ABM("A")="TMP(""ABM-RDNY"","_$J
  1.  S ABM="^"_ABM("A")_")"
  1.  I '$D(@ABM) Q
  1.  F  S ABM=$Q(@ABM) Q:ABM'[ABM("A")  D  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  .S ABM("T")=$P(ABM,"ABM-RDNY",2)
  1.  .S ABM("TXT")=+$P(ABM("T"),",",5)  ;BDFN
  1.  .S ABM("C")=$G(^ABMDBILL(DUZ(2),ABM("TXT"),0)) Q:ABM("C")=""
  1.  .Q:'ABM("C")!'$P(ABM("C"),U,7)!'$P(ABM("C"),U,8)
  1.  .S ABM("PRV")=$TR($P(ABM("T"),",",3,4),"""")  ;provider name
  1.  .;
  1.  .S ABMP("INS")=$P(ABM("C"),U,8)
  1.  .S ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
  1.  .S ABMP("VTYP")=$P(ABM("C"),U,7)
  1.  .S ABMP("CLN")=$P(ABM("C"),U,10)
  1.  .S ABMP("CLIN")=$$GET1^DIQ(40.7,$P(ABM("C"),U,10),"1","E")
  1.  .S ABMP("BDFN")=ABM("TXT")
  1.  .S ABMP("VDT")=$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U)
  1.  .S ABMP("BTYP")=$P(ABM("C"),U,2)
  1.  .S ABMP("LDFN")=$P(ABM("C"),U,3)
  1.  .S ABMP("EXP")=$P(ABM("C"),U,6)
  1.  .D CPTS  ;gather CPTs on claim
  1.  .D PSTING  ;gather posting info
  1.  .S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_",",ABMP("TOT")=0,ABMP("NC")=0
  1.  .D ^ABMDESM1
  1.  .;
  1.  .W !,$E($P(ABM("C"),U),1,10)  ;bill number
  1.  .W U_$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U))  ;DOS
  1.  .W U_$G(ABMT(1))  ;CPT/AMOUNT
  1.  .W U_$P($G(^AUTNINS($P(ABM("C"),U,8),0)),U)  ;active insurer
  1.  .W U_ABM("PRV")  ;provider
  1.  .W U_$FN(+$G(ABMS("TOT")),",",2)  ;billed
  1.  .W U_$FN(+$G(ABMD("P")),",",2)  ;paid
  1.  .W U_$G(ABMD(1))  ;denial/SAR
  1.  .S ABMD("DTOT")=+$G(ABMD("DTOT"))+$G(ABMD(1))
  1.  .S ABM("CNT")=ABM("CNT")+1,ABM("SUBCNT")=ABM("SUBCNT")+1
  1.  ;
  1.  D CLOSE^%ZISH("ABMF")
  1.  Q
  1.  ;
  1. HDB ;
  1.  S ABM("PG")=ABM("PG")+1
  1.  D WHD^ABMDRHD
  1.  W !,"Bill#^DOS^CPT/Amount^Active Insurer^Provider^Billed^Paid^Denied/SAR"
  1.  Q
  1.  ;
  1. CPTS ;EP
  1.  N ABM
  1.  K ABMRV,ABMT,ABMD
  1.  S ABMTCNT=1
  1.  D ^ABMEHGRV
  1.  S ABMI=0
  1.  F  S ABMI=$O(ABMRV(ABMI)) Q:'ABMI  D
  1.  .S ABMJ=0
  1.  .F  S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:'ABMJ  D
  1.  ..S ABMK=0
  1.  ..F  S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:(ABMK="")  D
  1.  ...I $G(ABMT(ABMTCNT))="" S ABMT(ABMTCNT)=$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,2)_"/"_+$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,6)
  1.  ...E  S ABMT(ABMTCNT)=ABMT(ABMTCNT)_";"_$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,2)_"/"_+$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,6)
  1.  Q
  1. PSTING ;EP
  1.  S ABMB=0
  1.  S ABMTCNT=1
  1.  F  S ABMB=$O(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB)) Q:'ABMB  D
  1.  .S ABMD("P")=+$G(ABMD("P"))+$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,10)
  1.  .F ABMA=3,4,6,7,9,12,13 D
  1.  ..I +$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)'=0 D
  1.  ...I $G(ABMD(ABMTCNT))="" S ABMD(ABMTCNT)=+$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)_"/"
  1.  ...E  S ABMD(ABMTCNT)=ABMD(ABMTCNT)_";"_+$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)_"/"
  1.  ...I +$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17)'=0 S ABMD(ABMTCNT)=ABMD(ABMTCNT)_$$GET1^DIQ(90056.06,$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17),".01","E")
  1.  Q