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