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

ABMDES3.m

Go to the documentation of this file. 
  1. ABMDES3 ; IHS/ASDST/DMJ - Display Summarized HCFA-1500B charges ; 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6,10,19**;NOV 12, 2009;Build 300
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS on line item
  1.  ; IHS/SD/SDR - v2.5 p6 - 7/12/04 - IM14097 - Added fix for FL Override for POS
  1.  ; IHS/SD/SDR - v2.5 p6 - 7/14/04 - IM14187 - Modified to get around bad X-refs if there are any
  1.  ; IHS/SD/SDR - v2.5 p8 - IM15905 - <UNDEF>HCFA+27^ABMDES3
  1.  ; IHS/SD/SDR - v2.5 p10 - IM21581 - Added active insurer print to summary
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*19 - HEAT235246 - Updated summary so T1015 will be first line to print.
  1.  ;
  1. HCFA ;EP for displaying charge summary for HCFA-1500
  1.  ;
  1.  D HD
  1.  ;I ABMP("EXP")=22 S ABMEXP=14  ;abm*2.6*6 5010
  1.  I ABMP("EXP")=22!(ABMP("EXP")=32) S ABMEXP=14  ;abm*2.6*6 5010
  1.  E  S ABMEXP=ABMP("EXP")
  1.  S ABMS=0 F  S ABMS=$O(ABMS(ABMS)) Q:'ABMS  D  Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
  1.  .I $Y>(IOSL-5) S DIR(0)="EO" D ^DIR W $$EN^ABMVDF("IOF") Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)  D HD
  1.  .;start new abm*2.6*19 IHS/SD/SDR HEAT235246
  1.  .I ($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"!($P($G(^AUTNINS(ABMP("INS"),0)),U)="ARBOR HEALTH PLAN")) D
  1.  ..S ABMIL=0
  1.  ..F  S ABMIL=$O(ABMS(ABMIL)) Q:'ABMIL  D
  1.  ...I $P($G(ABMS(ABMIL)),U,4)'="T1015" Q
  1.  ...S ABMTMP("TMP")=$G(ABMS(1))
  1.  ...S ABMS(1)=$G(ABMS(ABMIL))
  1.  ...S ABMS(ABMIL)=$G(ABMTMP("TMP"))
  1.  .K ABMIL,ABMTMP
  1.  .;end new abm*2.6*19 IHS/SD/SDR HEAT235246
  1.  .S ABMS("I")=1,ABMLN=0 D PROC^ABMDF3E
  1.  .W !,$$HDT^ABMDUTL($P(ABMR(ABMS,0),U))
  1.  .W ?11,$$HDT^ABMDUTL($P(ABMR(ABMS,0),U,2))
  1.  .;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3))!($D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4))) D  ;abm*2.6*10 HEAT53137
  1.  .I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3))!($D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4))) D  ;abm*2.6*10 HEAT53137
  1.  ..S ABMFL=0,ABMFLE=0
  1.  ..F ABMLN=3,4 D
  1.  ...;F  S ABMFL=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,ABMLN,ABMFL)) Q:ABMFL=""  I ^(ABMFL)'="^" S ABMFLE=1  ;abm*2.6*10 HEAT53137
  1.  ...F  S ABMFL=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,ABMLN,ABMFL)) Q:ABMFL=""  I ^(ABMFL)'="^" S ABMFLE=1  ;abm*2.6*10 HEAT53137
  1.  .I $G(ABMFLE)=1 D
  1.  ..S ABMFLMSG="Form Locator Override edits exist for POS/TOS"
  1.  ..;
  1.  ..S ABMVTYP=""
  1.  ..;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3)) D  ;abm*2.6*10 HEAT53137
  1.  ..I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3)) D  ;abm*2.6*10 HEAT53137
  1.  ...;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,0)) S ABMVTYP=0  ;abm*2.6*10 HEAT53137
  1.  ...I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,0)) S ABMVTYP=0  ;abm*2.6*10 HEAT53137
  1.  ...;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP")  ;abm*2.6*10 HEAT53137
  1.  ...I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP")  ;abm*2.6*10 HEAT53137
  1.  ...Q:+$G(ABMVTYP)=0
  1.  ...;S $P(ABMR(ABMS,0),U,3)=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMVTYP)  ;abm*2.6*10 HEAT53137
  1.  ...S $P(ABMR(ABMS,0),U,3)=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,3,ABMVTYP)  ;abm*2.6*10 HEAT53137
  1.  ..;
  1.  ..S ABMVTYP=""
  1.  ..;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4)) D  ;abm*2.6*10 HEAT53137
  1.  ..I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4)) D  ;abm*2.6*10 HEAT53137
  1.  ...;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,0)) S ABMVTYP=0  ;abm*2.6*10 HEAT53137
  1.  ...I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,0)) S ABMVTYP=0  ;abm*2.6*10 HEAT53137
  1.  ...;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP")  ;abm*2.6*10 HEAT53137
  1.  ...I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMP("VTYP"))) S ABMVTYP=ABMP("VTYP")  ;abm*2.6*10 HEAT53137
  1.  ...Q:+$G(ABMVTYP)=0
  1.  ...;S $P(ABMR(ABMS,0),U,4)=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMVTYP)  ;abm*2.6*10 HEAT53137
  1.  ...S $P(ABMR(ABMS,0),U,4)=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMEXP,37,4,ABMVTYP)  ;abm*2.6*10 HEAT53137
  1.  .W ?22,$J($P(ABMR(ABMS,0),U,3),2),?23,$J($P(ABMR(ABMS,0),U,4),2),?30,$S($P($G(ABMR(ABMS,(-1))),U)'="":$P(ABMR(ABMS,(-1)),U),1:$P(ABMR(ABMS,0),U,5))
  1.  .W ?49,$J($P(ABMR(ABMS,0),U,6),5),?56,$J($FN($P(ABMR(ABMS,0),U,7),",",2),10)
  1.  .W ?72,$J($P(ABMR(ABMS,0),U,8),3)
  1.  W !?58,"----------"
  1.  W !,?10,"TOTAL CHARGE",?56,$J($FN(ABMS("TOT"),",",2),10)
  1.  S ABMP("TOT")=ABMP("TOT")+ABMS("TOT")
  1.  I $G(ABMFLMSG)'="" W !!!!,ABMFLMSG
  1.  F  W ! Q:$Y+4>IOSL
  1.  S DIR(0)="E" D ^DIR K DIR
  1.  Q
  1.  ;
  1. HD ;SCREEN HEADER
  1.  W $$EN^ABMVDF("IOF")
  1.  W !,?20,"***** "
  1.  W $P(^ABMDEXP(ABMP("EXP"),0),U)
  1.  W " CHARGE SUMMARY *****"
  1.  W !!,"Active Insurer: ",$P($G(^AUTNINS(ABMP("INS"),0)),U),!
  1.  W !,?51,"Corr"
  1.  W !?1,"Charge Date  ",?21,"POS",?25,"TOS",?30," Description",?51,"Diag",?60,"Charge",?72,"Qty"
  1.  S ABMS("I")="",$P(ABMS("I"),"-",80)="" W !,ABMS("I")
  1.  Q