ABMECDS2 ; IHS/ASDST/DMJ - ELECTRONIC CLAIMS DISPLAY (SUMMARY) ;
;;2.6;IHS 3P BILLING SYSTEM;**19**;NOV 12, 2009;Build 300
;IHS/SD/SDR - 2.6*19 - HEAT138428 - Split routine from ABMECDSP. Made changes for clearinghouse so it will create
; one file for each visit location.
; *********************************************************************
;
DISP ;
; Display summary data
S ABMSUMPG=1
K ABMORE
W !
D SUMHEAD^ABMECDSP ;Write summary page column headers
;start old abm*2.6*6 5010
;S ABMSEQ=0 ;Sequence number
;S ABMINS("IEN")=0 ;Activer insurer IEN
;F S ABMINS("IEN")=$O(^TMP($J,"S",ABMINS("IEN"))) Q:'ABMINS("IEN") D Q:+ABMEQUIT
;.S ABMINS=$E($P($G(^AUTNINS(ABMINS("IEN"),0)),U),1,30) ; Insurer
;.S ABMVTYPE=0 ;Bill type
;.F S ABMVTYPE=$O(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE)) Q:'ABMVTYPE D Q:+ABMEQUIT
;..S ABMEXP=0 ;Mode of export
;..F S ABMEXP=$O(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP)) Q:'ABMEXP D Q:+ABMEQUIT
;...S ABMTAMT=$P(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U) ;Total amount
;...S ABMCNT=$P(^TMP($J,"S",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
;...S ABMSEQ=ABMSEQ+1 ;increment sequence number
;...W !,$J(ABMSEQ,3),?6,ABMINS,?38,$J(ABMVTYPE,3),?44,ABMEXPD,?60,$J(ABMCNT,4),?69,$J($FN(ABMTAMT,",",2),10)
;...; ABMER(#)=Insurer^Visit Type^Export mode^total count^total charge
;...S ABMER(ABMSEQ)=ABMINS("IEN")_U_ABMVTYPE_U_+ABMEXP_U_ABMCNT_U_ABMTAMT ; data array by sequence number
;...I $Y+5>IOSL D Q:+ABMEQUIT
;....D RETURN
;....Q:+ABMEQUIT
;....S ABMORE=1
;end old start new abm*2.6*6 5010
D GETCHS^ABMCUTL
S ABMSEQ=0,ABMNEXT=0
K ABMCHT
K ^TMP($J,"S-CH")
I $D(ABMCHLST) D ;clearinghouse exists; add another sort level
.S ABMP("CHIEN")=0,ABMSVTYP=0,ABMSEXP=0
.F S ABMP("CHIEN")=$O(ABMCHLST(ABMP("CHIEN"))) Q:'ABMP("CHIEN") D
..S ABMP("CHINS")=0
..F S ABMP("CHINS")=$O(ABMCHLST(ABMP("CHIEN"),ABMP("CHINS"))) Q:'ABMP("CHINS") D
...I $D(^TMP($J,"S",ABMP("CHINS"))) D
....S ABMVTYP=0
....F S ABMVTYP=$O(^TMP($J,"S",ABMP("CHINS"),ABMVTYP)) Q:'ABMVTYP D
.....S ABMEXP=0
.....F S ABMEXP=$O(^TMP($J,"S",ABMP("CHINS"),ABMVTYP,ABMEXP)) Q:'ABMEXP D
......I $D(ABMCHLST(ABMP("CHIEN"),ABMVTYP,ABMEXP)) S ABMSEQ=$G(ABMCHLST(ABMP("CHIEN"),ABMVTYP,ABMEXP))
......I '$D(ABMCHLST(ABMP("CHIEN"),ABMVTYP,ABMEXP)) S (ABMSEQ,ABMNEXT)=ABMNEXT+1,ABMCHLST(ABMP("CHIEN"),ABMVTYP,ABMEXP)=ABMSEQ
......M ^TMP($J,"S-CH",ABMSEQ,ABMP("CHIEN"),ABMP("CHINS"),ABMVTYP,ABMEXP)=^TMP($J,"S",ABMP("CHINS"),ABMVTYP,ABMEXP)
......S ABMCHT(ABMSEQ,"AMT")=+$G(ABMCHT(ABMSEQ,"AMT"))+$P(^TMP($J,"S-CH",ABMSEQ,ABMP("CHIEN"),ABMP("CHINS"),ABMVTYP,ABMEXP),U)
......S ABMCHT(ABMSEQ,"VTYP")=ABMVTYP
......S ABMCHT(ABMSEQ,"EXP")=ABMEXP
......S ABMCHT(ABMSEQ,"TOT")=+$G(ABMCHT(ABMSEQ,"TOT"))+$P(^TMP($J,"S",ABMP("CHINS"),ABMVTYP,ABMEXP),U,2)
......K ^TMP($J,"S",ABMP("CHINS"),ABMVTYP,ABMEXP)
......S ABMSINS=ABMP("CHINS"),ABMSVTYP=ABMVTYP,ABMSEXP=ABMEXP
;
S ABMSEQ=0 ;Sequence number
F S ABMSEQ=$O(^TMP($J,"S-CH",ABMSEQ)) Q:'ABMSEQ D Q:+ABMEQUIT
.S ABM("CHIEN")=0 ;clearinghouse IEN
.F S ABM("CHIEN")=$O(^TMP($J,"S-CH",ABMSEQ,ABM("CHIEN"))) Q:'ABM("CHIEN") D Q:+ABMEQUIT
..W !,$J(ABMSEQ,3),?6,"+ "_$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)
..S ABMINS("IEN")=0 ;Activer insurer IEN
..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
...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
.....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 desc
.....I $G(ABMORE) D SUMPGHD^ABMECDSP ;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)
.....; ABMER(#)=Insurer^Visit Type^Export mode^total count^total charge
.....S ABMER(ABMSEQ)=ABM("CHIEN")_U_ABMVTYPE_U_+ABMEXP_U_ABMCNT_U_ABMTAMT ;data array by sequence number
.....I $Y+5>IOSL D Q:+ABMEQUIT
......D RETURN^ABMECDSP
......Q:+ABMEQUIT
......S ABMORE=1
;
S ABMINS("IEN")=0 ;Activer insurer IEN
F S ABMINS("IEN")=$O(^TMP($J,"S",ABMINS("IEN"))) Q:'ABMINS("IEN") D Q:+ABMEQUIT
.S ABMINS=$E($P($G(^AUTNINS(ABMINS("IEN"),0)),U),1,30) ;Insurer
.S ABMVTYPE=0 ;Bill type
.F S ABMVTYPE=$O(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE)) Q:'ABMVTYPE D Q:+ABMEQUIT
..S ABMEXP=0 ;Mode of export
..F S ABMEXP=$O(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP)) Q:'ABMEXP D Q:+ABMEQUIT
...S ABMTAMT=$P(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U) ;Total amount
...S ABMCNT=$P(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U,2) ;Total count
...S ABMEXPD=$P($G(^ABMDEXP(+ABMEXP,0)),U) ;Export mode description
...I $G(ABMORE) D SUMPGHD^ABMECDSP ;if more than one page do page hdr
...S ABMNEXT=ABMNEXT+1 ;increment sequence number
...W !,$J(ABMNEXT,3),?6,ABMINS,?38,$J(ABMVTYPE,3),?44,ABMEXPD,?60,$J(ABMCNT,4),?69,$J($FN(ABMTAMT,",",2),10)
...; ABMER(#)=Insurer^Visit Type^Export mode^total count^total charge
...S ABMER(ABMNEXT)=ABMINS("IEN")_U_ABMVTYPE_U_+ABMEXP_U_ABMCNT_U_ABMTAMT ; data array by sequence number
...I $Y+5>IOSL D Q:+ABMEQUIT
....D RETURN^ABMECDSP
....Q:+ABMEQUIT
....S ABMORE=1
;end new abm*2.6*6 5010
Q
ABMECDS2 ; IHS/ASDST/DMJ - ELECTRONIC CLAIMS DISPLAY (SUMMARY) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**19**;NOV 12, 2009;Build 300
+2 ;IHS/SD/SDR - 2.6*19 - HEAT138428 - Split routine from ABMECDSP. Made changes for clearinghouse so it will create
+3 ; one file for each visit location.
+4 ; *********************************************************************
+5 ;
DISP ;
+1 ; Display summary data
+2 SET ABMSUMPG=1
+3 KILL ABMORE
+4 WRITE !
+5 ;Write summary page column headers
DO SUMHEAD^ABMECDSP
+6 ;start old abm*2.6*6 5010
+7 ;S ABMSEQ=0 ;Sequence number
+8 ;S ABMINS("IEN")=0 ;Activer insurer IEN
+9 ;F S ABMINS("IEN")=$O(^TMP($J,"S",ABMINS("IEN"))) Q:'ABMINS("IEN") D Q:+ABMEQUIT
+10 ;.S ABMINS=$E($P($G(^AUTNINS(ABMINS("IEN"),0)),U),1,30) ; Insurer
+11 ;.S ABMVTYPE=0 ;Bill type
+12 ;.F S ABMVTYPE=$O(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE)) Q:'ABMVTYPE D Q:+ABMEQUIT
+13 ;..S ABMEXP=0 ;Mode of export
+14 ;..F S ABMEXP=$O(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP)) Q:'ABMEXP D Q:+ABMEQUIT
+15 ;...S ABMTAMT=$P(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U) ;Total amount
+16 ;...S ABMCNT=$P(^TMP($J,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U,2) ;Total count
+17 ;...S ABMEXPD=$P($G(^ABMDEXP(+ABMEXP,0)),U) ;Export mode description
+18 ;...I $G(ABMORE) D SUMPGHD ;if more than one page do page hdr
+19 ;...S ABMSEQ=ABMSEQ+1 ;increment sequence number
+20 ;...W !,$J(ABMSEQ,3),?6,ABMINS,?38,$J(ABMVTYPE,3),?44,ABMEXPD,?60,$J(ABMCNT,4),?69,$J($FN(ABMTAMT,",",2),10)
+21 ;...; ABMER(#)=Insurer^Visit Type^Export mode^total count^total charge
+22 ;...S ABMER(ABMSEQ)=ABMINS("IEN")_U_ABMVTYPE_U_+ABMEXP_U_ABMCNT_U_ABMTAMT ; data array by sequence number
+23 ;...I $Y+5>IOSL D Q:+ABMEQUIT
+24 ;....D RETURN
+25 ;....Q:+ABMEQUIT
+26 ;....S ABMORE=1
+27 ;end old start new abm*2.6*6 5010
+28 DO GETCHS^ABMCUTL
+29 SET ABMSEQ=0
SET ABMNEXT=0
+30 KILL ABMCHT
+31 KILL ^TMP($JOB,"S-CH")
+32 ;clearinghouse exists; add another sort level
IF $DATA(ABMCHLST)
Begin DoDot:1
+33 SET ABMP("CHIEN")=0
SET ABMSVTYP=0
SET ABMSEXP=0
+34 FOR
SET ABMP("CHIEN")=$ORDER(ABMCHLST(ABMP("CHIEN")))
IF 'ABMP("CHIEN")
QUIT
Begin DoDot:2
+35 SET ABMP("CHINS")=0
+36 FOR
SET ABMP("CHINS")=$ORDER(ABMCHLST(ABMP("CHIEN"),ABMP("CHINS")))
IF 'ABMP("CHINS")
QUIT
Begin DoDot:3
+37 IF $DATA(^TMP($JOB,"S",ABMP("CHINS")))
Begin DoDot:4
+38 SET ABMVTYP=0
+39 FOR
SET ABMVTYP=$ORDER(^TMP($JOB,"S",ABMP("CHINS"),ABMVTYP))
IF 'ABMVTYP
QUIT
Begin DoDot:5
+40 SET ABMEXP=0
+41 FOR
SET ABMEXP=$ORDER(^TMP($JOB,"S",ABMP("CHINS"),ABMVTYP,ABMEXP))
IF 'ABMEXP
QUIT
Begin DoDot:6
+42 IF $DATA(ABMCHLST(ABMP("CHIEN"),ABMVTYP,ABMEXP))
SET ABMSEQ=$GET(ABMCHLST(ABMP("CHIEN"),ABMVTYP,ABMEXP))
+43 IF '$DATA(ABMCHLST(ABMP("CHIEN"),ABMVTYP,ABMEXP))
SET (ABMSEQ,ABMNEXT)=ABMNEXT+1
SET ABMCHLST(ABMP("CHIEN"),ABMVTYP,ABMEXP)=ABMSEQ
+44 MERGE ^TMP($JOB,"S-CH",ABMSEQ,ABMP("CHIEN"),ABMP("CHINS"),ABMVTYP,ABMEXP)=^TMP($JOB,"S",ABMP("CHINS"),ABMVTYP,ABMEXP)
+45 SET ABMCHT(ABMSEQ,"AMT")=+$GET(ABMCHT(ABMSEQ,"AMT"))+$PIECE(^TMP($JOB,"S-CH",ABMSEQ,ABMP("CHIEN"),ABMP("CHINS"),ABMVTYP,ABMEXP),U)
+46 SET ABMCHT(ABMSEQ,"VTYP")=ABMVTYP
+47 SET ABMCHT(ABMSEQ,"EXP")=ABMEXP
+48 SET ABMCHT(ABMSEQ,"TOT")=+$GET(ABMCHT(ABMSEQ,"TOT"))+$PIECE(^TMP($JOB,"S",ABMP("CHINS"),ABMVTYP,ABMEXP),U,2)
+49 KILL ^TMP($JOB,"S",ABMP("CHINS"),ABMVTYP,ABMEXP)
+50 SET ABMSINS=ABMP("CHINS")
SET ABMSVTYP=ABMVTYP
SET ABMSEXP=ABMEXP
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 ;Sequence number
SET ABMSEQ=0
+53 FOR
SET ABMSEQ=$ORDER(^TMP($JOB,"S-CH",ABMSEQ))
IF 'ABMSEQ
QUIT
Begin DoDot:1
+54 ;clearinghouse IEN
SET ABM("CHIEN")=0
+55 FOR
SET ABM("CHIEN")=$ORDER(^TMP($JOB,"S-CH",ABMSEQ,ABM("CHIEN")))
IF 'ABM("CHIEN")
QUIT
Begin DoDot:2
+56 WRITE !,$JUSTIFY(ABMSEQ,3),?6,"+ "_$PIECE($GET(^ABMRECVR(ABM("CHIEN"),0)),U)
+57 WRITE ?38,$JUSTIFY(ABMCHT(ABMSEQ,"VTYP"),3),?44,$PIECE($GET(^ABMDEXP(ABMCHT(ABMSEQ,"EXP"),0)),U)
+58 WRITE ?60,$JUSTIFY(ABMCHT(ABMSEQ,"TOT"),4),?69,$JUSTIFY($FNUMBER(ABMCHT(ABMSEQ,"AMT"),",",2),10)
+59 ;Activer insurer IEN
SET ABMINS("IEN")=0
+60 FOR
SET ABMINS("IEN")=$ORDER(^TMP($JOB,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN")))
IF 'ABMINS("IEN")
QUIT
Begin DoDot:3
+61 ;Insurer
SET ABMINS=$EXTRACT($PIECE($GET(^AUTNINS(ABMINS("IEN"),0)),U),1,30)
+62 ;Bill type
SET ABMVTYPE=0
+63 FOR
SET ABMVTYPE=$ORDER(^TMP($JOB,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"),ABMVTYPE))
IF 'ABMVTYPE
QUIT
Begin DoDot:4
+64 ;Mode of export
SET ABMEXP=0
+65 FOR
SET ABMEXP=$ORDER(^TMP($JOB,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"),ABMVTYPE,ABMEXP))
IF 'ABMEXP
QUIT
Begin DoDot:5
+66 ;Total amount
SET ABMTAMT=$PIECE(^TMP($JOB,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"),ABMVTYPE,ABMEXP),U)
+67 ;Total count
SET ABMCNT=$PIECE(^TMP($JOB,"S-CH",ABMSEQ,ABM("CHIEN"),ABMINS("IEN"),ABMVTYPE,ABMEXP),U,2)
+68 ;Export mode desc
SET ABMEXPD=$PIECE($GET(^ABMDEXP(+ABMEXP,0)),U)
+69 ;if more than one page do page hdr
IF $GET(ABMORE)
DO SUMPGHD^ABMECDSP
+70 ;W !
+71 ;W ?6,ABMINS,?38,$J(ABMVTYPE,3),?44,ABMEXPD,?60,$J(ABMCNT,4),?69,$J($FN(ABMTAMT,",",2),10)
+72 ; ABMER(#)=Insurer^Visit Type^Export mode^total count^total charge
+73 ;data array by sequence number
SET ABMER(ABMSEQ)=ABM("CHIEN")_U_ABMVTYPE_U_+ABMEXP_U_ABMCNT_U_ABMTAMT
+74 IF $Y+5>IOSL
Begin DoDot:6
+75 DO RETURN^ABMECDSP
+76 IF +ABMEQUIT
QUIT
+77 SET ABMORE=1
End DoDot:6
IF +ABMEQUIT
QUIT
End DoDot:5
IF +ABMEQUIT
QUIT
End DoDot:4
IF +ABMEQUIT
QUIT
End DoDot:3
IF +ABMEQUIT
QUIT
End DoDot:2
IF +ABMEQUIT
QUIT
End DoDot:1
IF +ABMEQUIT
QUIT
+78 ;
+79 ;Activer insurer IEN
SET ABMINS("IEN")=0
+80 FOR
SET ABMINS("IEN")=$ORDER(^TMP($JOB,"S",ABMINS("IEN")))
IF 'ABMINS("IEN")
QUIT
Begin DoDot:1
+81 ;Insurer
SET ABMINS=$EXTRACT($PIECE($GET(^AUTNINS(ABMINS("IEN"),0)),U),1,30)
+82 ;Bill type
SET ABMVTYPE=0
+83 FOR
SET ABMVTYPE=$ORDER(^TMP($JOB,"S",ABMINS("IEN"),ABMVTYPE))
IF 'ABMVTYPE
QUIT
Begin DoDot:2
+84 ;Mode of export
SET ABMEXP=0
+85 FOR
SET ABMEXP=$ORDER(^TMP($JOB,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP))
IF 'ABMEXP
QUIT
Begin DoDot:3
+86 ;Total amount
SET ABMTAMT=$PIECE(^TMP($JOB,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U)
+87 ;Total count
SET ABMCNT=$PIECE(^TMP($JOB,"S",ABMINS("IEN"),ABMVTYPE,ABMEXP),U,2)
+88 ;Export mode description
SET ABMEXPD=$PIECE($GET(^ABMDEXP(+ABMEXP,0)),U)
+89 ;if more than one page do page hdr
IF $GET(ABMORE)
DO SUMPGHD^ABMECDSP
+90 ;increment sequence number
SET ABMNEXT=ABMNEXT+1
+91 WRITE !,$JUSTIFY(ABMNEXT,3),?6,ABMINS,?38,$JUSTIFY(ABMVTYPE,3),?44,ABMEXPD,?60,$JUSTIFY(ABMCNT,4),?69,$JUSTIFY($FNUMBER(ABMTAMT,",",2),10)
+92 ; ABMER(#)=Insurer^Visit Type^Export mode^total count^total charge
+93 ; data array by sequence number
SET ABMER(ABMNEXT)=ABMINS("IEN")_U_ABMVTYPE_U_+ABMEXP_U_ABMCNT_U_ABMTAMT
+94 IF $Y+5>IOSL
Begin DoDot:4
+95 DO RETURN^ABMECDSP
+96 IF +ABMEQUIT
QUIT
+97 SET ABMORE=1
End DoDot:4
IF +ABMEQUIT
QUIT
End DoDot:3
IF +ABMEQUIT
QUIT
End DoDot:2
IF +ABMEQUIT
QUIT
End DoDot:1
IF +ABMEQUIT
QUIT
+98 ;end new abm*2.6*6 5010
+99 QUIT
