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

ABMECDSP.m

Go to the documentation of this file. 
  1. ABMECDSP ; IHS/ASDST/DMJ - ELECTRONIC CLAIMS DISPLAY (SUMMARY) ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6,8,10,19**;NOV 12, 2009;Build 300
  1.  ; IHS/SD/SDR - abm*2.6*6 - 5010 - added clearinghouse code
  1.  ;IHS/SD/SDR - 2.6*19 - HEAT138428 - Made changes for clearinghouse so it will create one file for each
  1.  ;   visit location.
  1.  ; *********************************************************************
  1. START ;   
  1.  D INIT                 ; Initialize variables
  1.  D GDATA1               ; Find approved bills needing export
  1.  Q:'$D(^TMP($J))        ; Quit if no electronic bills to export
  1.  D DISP^ABMECDS2        ; Display summary data
  1.  D ASKDET               ; Ask if user wants to see detail
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  I $G(ABMDET) D
  1.  .D ASKSEQ             ; Ask for seq # to show detail
  1.  .Q:ABMSEQ=""!($D(DTOUT))!($D(DUOUT))  ;abm*2.6*6 5010  ;abm*2.6*8
  1.  .;Q:ABMNEXT=""!($D(DTOUT))!($D(DUOUT))  ;abm*2.6*6 5010  ;abm*2.6*8
  1.  .D DETHEAD            ; Write detail report headers
  1.  .D DISPDET            ; Display detail report
  1.  .Q
  1.  I +$G(ABMEQUIT) D CLEANUP Q
  1.  D RETURN               ; Press return to continue
  1.  D CLEANUP              ; Clean up variables
  1.  Q
  1. EMCREAT(ABMER,ABMSEQ) ; EP
  1.  ; Called from 'EMC Create a Batch'
  1.  ;
  1.  ; Output: AMBER array  = Array of batch data by sequence number
  1.  ;         ABMSEQ       = Sequence number of batch
  1.  D INIT
  1.  D GDATA1
  1.  Q:'$D(^TMP($J))
  1.  D DISP^ABMECDS2
  1.  D ASKSEQ
  1.  Q
  1. INIT ;
  1.  K ^TMP($J)
  1.  S $P(ABME("-"),"-",81)=""
  1.  S $P(ABME("="),"=",81)=""
  1.  S ABMSEQ=0
  1.  S ABMEQUIT=0
  1.  Q
  1. GDATA1 ;  
  1.  ; Loop through bills that have been approved but not yet exported.
  1.  ; "AC","A" cross-reference of ^ABMDBILL
  1.  S DA=0
  1.  F  S DA=$O(^ABMDBILL(DUZ(2),"AC","A",DA)) Q:'DA  D LOOP
  1.  I '$D(^TMP($J)) W !!,"There are no electronic bills awaiting transmission." D RETURN Q:+ABMEQUIT
  1.  Q
  1. LOOP ;
  1.  ; If the bill is to be exported electronically, collect data and 
  1.  ; and build temporary summary "S" and detail "D" globals
  1.  S ABMBILL0=$G(^ABMDBILL(DUZ(2),DA,0))
  1.  Q:$P(ABMBILL0,U,4)="X"  ;Q if status is cancelled
  1.  S ABMEXP=$P(ABMBILL0,U,6)  ;Export mode
  1.  Q:ABMEXP=""
  1.  Q:$P($G(^ABMDEXP(ABMEXP,1)),U,5)'="E"  ;Quit if not electronic
  1.  S ABME("LDFN")=$P(ABMBILL0,U,3)  ;Location IEN
  1.  S ABMLOC=$P($G(^AUTTLOC(+ABME("LDFN"),0)),U,2)_"@"_ABME("LDFN")
  1.  S:ABMLOC="" ABMLOC="UNKNOWN"  ;Location
  1.  S ABMVTYPE=$P(ABMBILL0,U,7)  ;Visit type
  1.  S ABMINS("IEN")=$P(ABMBILL0,U,8)  ;Active insurer IEN
  1.  S ABMBAMT=$P($G(^ABMDBILL(DUZ(2),DA,2)),U)  ;Bill amount
  1.  S $P(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U)=$P($G(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP)),U)+ABMBAMT
  1.  S $P(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U,2)=$P($G(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP)),U,2)+1
  1.  S ^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE,ABMEXP,DA)=ABMBAMT
  1.  Q
  1. DISP ;
  1.  D DISP^ABMECDS2  ;abm*2.6*19 IHS/SD/DSR HEAT138428 split to ABMECDS2
  1.  Q
  1. ASKDET ;  
  1.  ; Ask user if they wish to see detail
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Show detail "
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  K DIR
  1.  I Y=1 S ABMDET=1
  1.  Q
  1. ASKSEQ ;
  1.  ; Ask user the sequence number for which they want to see detail
  1.  W !
  1.  ;start old code abm*2.6*6 5010
  1.  ;S DIR(0)="NO^^K:(X<1!(X>ABMSEQ)) X"
  1.  ;S DIR("A")="What sequence number (1 - "_ABMSEQ_")"
  1.  ;S DIR("?")="Enter a number between 1 and "_ABMSEQ
  1.  ;end old code start new code 5010
  1.  S DIR(0)="NO^^K:(X<1!(X>ABMNEXT)) X"
  1.  S DIR("A")="What sequence number (1 - "_ABMNEXT_")"
  1.  S DIR("?")="Enter a number between 1 and "_ABMNEXT
  1.  D ^DIR
  1.  K DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  S ABMSEQ=Y
  1.  Q:'ABMSEQ
  1.  Q:'$D(^TMP($J,"S-CH",ABMSEQ))
  1.  S ABM("CHIEN")=$P(ABMER(ABMSEQ),U)
  1.  W !!,$J(ABMSEQ,3),?5,"+ "_$P($G(^ABMRECVR(ABM("CHIEN"),0)),U)
  1.  W ?38,$J(ABMCHT(ABMSEQ,"VTYP"),3),?44,$P($G(^ABMDEXP(ABMCHT(ABMSEQ,"EXP"),0)),U)
  1.  W ?60,$J(ABMCHT(ABMSEQ,"TOT"),4),?69,$J($FN(ABMCHT(ABMSEQ,"AMT"),",",2),10)
  1.  W !
  1.  S ABMINS("IEN")=0
  1.  F  S ABMINS("IEN")=$O(^TMP($J,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"))) Q:'ABMINS("IEN")  D  Q:+ABMEQUIT
  1.  .;S ABMINS=$E($P($G(^AUTNINS(ABMINS("IEN"),0)),U),1,30)  ;Insurer  ;abm*2.6*19 IHS/SD/SDR HEAT138428
  1.  .S ABMVTYPE=0  ;Bill type
  1.  .F  S ABMVTYPE=$O(^TMP($J,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"),ABMVTYPE)) Q:'ABMVTYPE  D  Q:+ABMEQUIT
  1.  ..S ABMEXP=0  ;Mode of export
  1.  ..F  S ABMEXP=$O(^TMP($J,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"),ABMVTYPE,ABMEXP)) Q:'ABMEXP  D  Q:+ABMEQUIT
  1.  ...;start old abm*2.6*19 IHS/SD/SDR HEAT138428
  1.  ...;S ABMTAMT=$P(^TMP($J,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"),ABMVTYPE,ABMEXP),U)  ;Total amount
  1.  ...;S ABMCNT=$P(^TMP($J,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"),ABMVTYPE,ABMEXP),U,2)  ;Total count
  1.  ...;S ABMEXPD=$P($G(^ABMDEXP(+ABMEXP,0)),U)  ;Export mode description
  1.  ...;I $G(ABMORE) D SUMPGHD  ;if more than one page do page hdr
  1.  ...;W !
  1.  ...;W ?6,ABMINS,?38,$J(ABMVTYPE,3),?44,ABMEXPD,?60,$J(ABMCNT,4),?69,$J($FN(ABMTAMT,",",2),10)
  1.  ...;end old start new abm*2.6*19 IHS/SD/SDR HEAT138428
  1.  ...S ABMLOC=""
  1.  ...F  S ABMLOC=$O(^TMP($J,"D",ABMINS("IEN"),ABMLOC)) Q:ABMLOC=""  D
  1.  ....S ABMB=0
  1.  ....F  S ABMB=$O(^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE,ABMEXP,ABMB)) Q:'ABMB  D
  1.  .....S $P(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"),ABMVTYPE,ABMEXP),U,2)=+$P($G(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"),ABMVTYPE,ABMEXP)),U,2)+1
  1.  .....S $P(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"),ABMVTYPE,ABMEXP),U)=$P(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"),ABMVTYPE,ABMEXP),U)+$G(^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE,ABMEXP,ABMB))
  1.  S ABMLOC=""
  1.  F  S ABMLOC=$O(^TMP($J,"FILE",ABMLOC)) Q:ABMLOC=""  D
  1.  .S ABMINS("IEN")=0
  1.  .F  S ABMINS("IEN")=$O(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"))) Q:'ABMINS("IEN")  D
  1.  ..S ABMVTYPE=0
  1.  ..F  S ABMVTYPE=$O(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"),ABMVTYPE)) Q:'ABMVTYPE  D
  1.  ...S ABMEXP=0
  1.  ...F  S ABMEXP=$O(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"),ABMVTYPE,ABMEXP)) Q:'ABMEXP  D
  1.  ....S ABMINS=$P($G(^AUTNINS(ABMINS("IEN"),0)),U)  ;Insurer
  1.  ....S ABMTAMT=$P($G(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"),ABMVTYPE,ABMEXP)),U)  ;Total amount
  1.  ....S ABMCNT=$P($G(^TMP($J,"FILE",ABMLOC,ABMINS("IEN"),ABMVTYPE,ABMEXP)),U,2)  ;Total count
  1.  ....S ABMEXPD=$P($G(^ABMDEXP(+ABMEXP,0)),U)  ;Export mode description
  1.  ....I $G(ABMORE) D SUMPGHD  ;if more than one page do page hdr
  1.  ....W !
  1.  ....W ?2,$E(ABMLOC,1,16),?19,$E(ABMINS,1,18),?38,$J(ABMVTYPE,3),?44,ABMEXPD,?60,$J(ABMCNT,4),?69,$J($FN(ABMTAMT,",",2),10)
  1.  ;end new abm*2.6*19 IHS/SD/SDR HEAT138428
  1.  ...W !
  1.  ...W ?6,ABMINS,?38,$J(ABMVTYPE,3),?44,ABMEXPD,?60,$J(ABMCNT,4),?69,$J($FN(ABMTAMT,",",2),10)
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Proceed"
  1.  S DIR("B")="YES"
  1.  D ^DIR
  1.  K DIR
  1.  ;I Y'=1 K ABMSEQ Q  ;abm*2.6*8
  1.  I Y'=1 S ABMSEQ="" Q  ;abm*2.6*8
  1.  ;end new code 5010
  1.  Q
  1. DISPDET ;
  1.  I $D(^TMP($J,"S-CH",ABMSEQ)) D DISPMULT Q  ;abm*2.6*6 5010
  1.  S ABMEXP=$P(ABMER(ABMSEQ),U,3)  ;Export Mode
  1.  S ABMINS("IEN")=$P(ABMER(ABMSEQ),U)  ;Active insurer IEN
  1.  S ABMVTYPE=$P(ABMER(ABMSEQ),U,2)  ;Visit type
  1.  S ABMLOC=""
  1.  S ABMSITE=0
  1.  F  S ABMLOC=$O(^TMP($J,"D",ABMINS("IEN"),ABMLOC)) Q:ABMLOC=""  D  Q:+$G(ABMEQUIT)
  1.  .Q:$D(^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE))<2
  1.  .S ABMIEN=0
  1.  .W !!,$P(ABMLOC,"@"),?40,"VISIT TYPE: ",$P(^ABMDVTYP(ABMVTYPE,0),U),!
  1.  .F  S ABMIEN=$O(^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE,ABMEXP,ABMIEN)) Q:'+ABMIEN  D  Q:+$G(ABMEQUIT)
  1.  ..S ABMBAMT=^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE,ABMEXP,ABMIEN)  ;Bill amount
  1.  ..S ABMTOT=$G(ABMTOT)+ABMBAMT  ;Total amount for detail rpt
  1.  ..S ABMSITE=$G(ABMSITE)+ABMBAMT  ;Tot amt per site on detail rpt
  1.  ..F I=1,3,5 S ABME(I)=$P(^ABMDBILL(DUZ(2),ABMIEN,0),U,I)
  1.  ..S ABMHRN=$P($G(^AUPNPAT(+ABME(5),41,+ABME(3),0)),U,2)  ;HRN
  1.  ..S ABMPAT=$P($G(^DPT(+ABME(5),0)),U)  ;Patient name
  1.  ..S ABMSRV=$P($G(^ABMDBILL(DUZ(2),ABMIEN,7)),U)
  1.  ..S Y=ABMSRV
  1.  ..D DD^%DT
  1.  ..S ABMSRV=Y  ;Service date from
  1.  ..W !?3,ABME(1),?13,ABMHRN,?21,ABMPAT,?51,ABMSRV,?68,$J($FN(ABMBAMT,",",2),10)
  1.  ..I $Y+5>IOSL D RETURN Q:+ABMEQUIT  D DETHEAD
  1.  .Q:+ABMEQUIT
  1.  .W !?68,"----------"
  1.  .W !?68,$J($FN(ABMSITE,",",2),10)
  1.  .S ABMSITE=0
  1.  Q:+ABMEQUIT
  1.  W !!?20,"TOTAL",?68,$J($FN(ABMTOT,",",2),10)
  1.  Q
  1.  ;start new abm*2.6*6 5010
  1. DISPMULT ;
  1.  S ABMEXP=$P(ABMER(ABMSEQ),U,3)  ;Export Mode
  1.  S ABMVTYPE=$P(ABMER(ABMSEQ),U,2)  ;Visit type
  1.  S ABMLOC=""
  1.  S ABMSITE=0
  1.  S ABM("CHIEN")=0
  1.  F  S ABM("CHIEN")=$O(^TMP($J,"S-CH",ABMSEQ,ABM("CHIEN"))) Q:'ABM("CHIEN")  D
  1.  .S ABMINS("IEN")=0
  1.  .F  S ABMINS("IEN")=$O(^TMP($J,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"))) Q:'ABMINS("IEN")  D
  1.  ..S ABMLOC=""
  1.  ..F  S ABMLOC=$O(^TMP($J,"D",ABMINS("IEN"),ABMLOC)) Q:ABMLOC=""  D  Q:+$G(ABMEQUIT)
  1.  ...Q:$D(^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE))<2
  1.  ...S ABMIEN=0
  1.  ...W !!,$P(ABMLOC,"@"),?15,$P($G(^AUTNINS(ABMINS("IEN"),0)),U),?40,"VISIT TYPE: ",$P(^ABMDVTYP(ABMVTYPE,0),U),!
  1.  ...F  S ABMIEN=$O(^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE,ABMEXP,ABMIEN)) Q:'+ABMIEN  D  Q:+$G(ABMEQUIT)
  1.  ....S ABMBAMT=^TMP($J,"D",ABMINS("IEN"),ABMLOC,ABMVTYPE,ABMEXP,ABMIEN)  ;Bill amount
  1.  ....S ABMTOT=$G(ABMTOT)+ABMBAMT  ;Total amount for detail rpt
  1.  ....S ABMSITE=$G(ABMSITE)+ABMBAMT  ;Tot amt per site on detail rpt
  1.  ....F I=1,3,5 S ABME(I)=$P(^ABMDBILL(DUZ(2),ABMIEN,0),U,I)
  1.  ....S ABMHRN=$P($G(^AUPNPAT(+ABME(5),41,+ABME(3),0)),U,2)  ;HRN
  1.  ....S ABMPAT=$P($G(^DPT(+ABME(5),0)),U)  ;Patient name
  1.  ....S ABMSRV=$P($G(^ABMDBILL(DUZ(2),ABMIEN,7)),U)
  1.  ....S Y=ABMSRV
  1.  ....D DD^%DT
  1.  ....S ABMSRV=Y  ;Service date from
  1.  ....W !?3,ABME(1),?13,ABMHRN,?21,ABMPAT,?51,ABMSRV,?68,$J($FN(ABMBAMT,",",2),10)
  1.  ....I $Y+5>IOSL D RETURN Q:+ABMEQUIT  D DETHEAD
  1.  ...Q:+ABMEQUIT
  1.  ...W !?68,"----------"
  1.  ...W !?68,$J($FN(ABMSITE,",",2),10)
  1.  ...S ABMSITE=0
  1.  Q:+ABMEQUIT
  1.  W !!?20,"TOTAL",?68,$J($FN(ABMTOT,",",2),10)
  1.  Q
  1.  ;end new
  1. SUMHEAD ; 
  1.  ; Column headings for summary report
  1.  ;start new abm*2.6*6 5010
  1.  I $D(ABMCHLST)'="" D  Q
  1.  .;W !,"SEQ",?6,"INSURER/CLEARINGHOUSE",?33,"BILL TYPE",?44,"EXPORT MODE",?57,"# OF BILLS",?71,"BILL AMT",!,ABME("-"),!  ;abm*2.6*10 IHS/SD/AML 8/2/12 HEAT78833
  1.  .W !,?37,"VISIT",?61,"# OF"  ;abm*2.6*10 IHS/SD/AML 8/2/12  HEAT78833
  1.  .W !,"SEQ",?6,"INSURER/CLEARINGHOUSE",?37,"TYPE",?44,"EXPORT MODE",?61,"BILLS",?71,"BILL AMT",!,ABME("-"),!  ;abm*2.6*10 IHS/SD/AML 8/2/12 HEAT78833
  1.  ;end new 5010
  1.  W !,"SEQ",?6,"INSURER",?33,"BILL TYPE",?44,"EXPORT MODE",?57,"# OF BILLS",?71,"BILL AMT",!,ABME("-"),!
  1.  Q
  1. RETURN ;
  1.  ; Press return to cont
  1.  W !
  1.  S ABMEQUIT=0
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  K DIR
  1.  I 'Y S ABMEQUIT=1
  1.  Q
  1. SUMPGHD ;  
  1.  ; Page hdr for add'l pages of summary rpt
  1.  K ABMORE
  1.  S ABMSUMPG=ABMSUMPG+1
  1.  W $$EN^ABMVDF("IOF"),!?21,"SUMMARY OF BILLS READY FOR SUBMISSION",?70,"Page: ",ABMSUMPG,!!
  1.  D SUMHEAD
  1.  Q
  1. DETHEAD ;
  1.  ;Rpt title & column hdgs for detail rpt
  1.  S ABMDETPG=$G(ABMDETPG)+1
  1.  W $$EN^ABMVDF("IOF"),!?27,"BILLS READY FOR SUBMISSION",?70,"Page: ",ABMDETPG
  1.  W !?10,"FORMAT: ",$P(^ABMDEXP($P(ABMER(ABMSEQ),U,3),0),U,7),!
  1.  W !,ABME("=")
  1.  W !,"BILL #",?13,"HRN",?21,"PATIENT",?48,"SERVICE DATE FROM",?72,"AMOUNT"
  1.  W !,ABME("-")
  1.  Q
  1. CLEANUP ;
  1.  K ^TMP($J)
  1.  K ABMBAMT,ABMBILL0,ABMVTYPE,ABMCNT,ABMDET,ABMDETPG,ABME,ABMEQUIT,ABMER
  1.  K ABMEXP,ABMEXPD,ABMHRN,ABMIEN,ABMINS,ABMLOC,ABMORE,ABMPAT,ABMSEQ
  1.  K ABMSITE,ABMSRV,ABMSUMPG,ABMTAMT,ABMTOT
  1.  Q