ABMERSND ; IHS/ASDST/DMJ - RE-SEND A BATCH OF BILLS ELECTRONIC FORMAT ;
;;2.6;IHS Third Party Billing System;**2,6,8**;NOV 12, 2009
;Original;DMJ;
; IHS/SD/SDR - abm*2.6*2 - 5PMS10005 - Set var for 3P Bill EXPORT NUMBER RE-EXPORT multiple
; IHS/SD/SDR - abm*2.6*6 - 5010 - Changes for clearinghouse
;
START ;START HERE
W !
S DIC="^ABMDTXST(DUZ(2),"
S DIC(0)="AEMQ"
S DIC("S")="I $L($P($G(^(1)),""^"",4))"
D ^DIC
K DIC
Q:Y<0
S ABMP("XMIT")=+Y
;start new code abm*2.6*6 5010
LIST ; EP
W !!,"Checking...",!
K ABMT("XLIST")
K ABMT("CHKLIST")
S ABMT("XCNT")=0
S ABMT("XLINE")=1
S ABMT("SIEN")=$O(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,9999999),-1) ;look at last entry only
I ABMT("SIEN")'="" S ABMT("ORIGGCN")=$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMT("SIEN"),0)),U,2)
I $G(ABMT("ORIGGCN"))="" S ABMT("ORIGGCN")=$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),1)),U,6)
;
S ABMT("XMIT")=0
F S ABMT("XMIT")=$O(^ABMDTXST(DUZ(2),"EGCN",ABMT("ORIGGCN"),ABMT("XMIT"))) Q:'+ABMT("XMIT") D
.S ABMT("SIEN")=$O(^ABMDTXST(DUZ(2),ABMT("XMIT"),3,9999999),-1) ;look at last entry only
.I ABMT("SIEN")'="" S ABMT("GCN")=$P($G(^ABMDTXST(DUZ(2),ABMT("XMIT"),3,ABMT("SIEN"),0)),U,2)
.I $G(ABMT("GCN"))="" S ABMT("GCN")=$P($G(^ABMDTXST(DUZ(2),ABMT("XMIT"),1)),U,6)
.Q:(ABMT("GCN")'=ABMT("ORIGGCN"))
.S ABMT("CHKLIST",ABMT("XMIT"))=1
.S ABMT("XLIST",ABMT("XLINE"),ABMT("XMIT"),ABMT("SIEN"),ABMT("GCN"))=""
.S ABMT("GLIST",ABMT("GCN"))=""
.S ABMT("XCNT")=+$G(ABMT("XCNT"))+1,ABMT("XLINE")=+$G(ABMT("XLINE"))+1
I '$D(ABMT("XLIST")) D
.F S ABMT("XMIT")=$O(^ABMDTXST(DUZ(2),"C",ABMT("ORIGGCN"),ABMT("XMIT"))) Q:'+ABMT("XMIT")
..I $G(ABMT("GCN"))="" S ABMT("GCN")=$P($G(^ABMDTXST(DUZ(2),ABMT("XMIT"),1)),U,6)
..Q:(ABMT("GCN")'=ABMT("ORIGGCN"))
..S ABMT("CHKLIST",ABMT("XMIT"))=1
..S ABMT("XLIST",ABMT("XLINE"),ABMT("XMIT"))=""
..S ABMT("GLIST",ABMT("GCN"))=""
.S ABMT("XCNT")=+$G(ABMT("XCNT"))+1,ABMT("XLINE")=+$G(ABMT("XLINE"))+1
S ABMER("LAST")=+$G(ABMT("XCNT")) ;abm*2.6*8
;
I +$G(ABMT("XCNT"))>1 D
.W !,"There are multiple batches associated with your selection."
.W !!,"Select from the following:",!
D BATCHLST
S ABMQUIT=0
I +$G(ABMT("XCNT"))>1 D
.K DIR,DIE,DIC,X,Y,DA
.S DIR(0)="SO^1:All associated batches;2:A single batch entry;3:Reselect export dates;4:Quit"
.S DIR("A")="Select"
.D ^DIR K DIR
.S ABMANS=+Y
.I ABMANS=1 ;print all entries
.I ABMANS=2 D ;select one entry
..D BATCHLST
..K DIR,DIE,DIC,X,Y,DA
..S DIR(0)="NO^1:"_(ABMT("XCNT")-1)
..S DIR("A")="Select"
..D ^DIR K DIR
..I +Y=0 S ABMQUIT=1
..S ABMSEL=Y
.I ABMANS=3 G START ;start over
.I ABMANS=4 S ABMQUIT=1 Q ;quit w/out printing anything
Q:ABMQUIT
I $G(ABMANS)=2 D
.S ABMT("XCNT")=ABMSEL
.S ABMECHK=0
.F S ABMECHK=$O(ABMT("XLIST",ABMECHK)) Q:'ABMECHK D
..I ABMECHK'=ABMSEL K ABMT("XLIST",ABMECHK)
.M ABMT("XLIST",1)=ABMT("XLIST",ABMSEL)
.S (ABMER("CNT"),ABMER("LAST"))=1
;
S:+$G(ABMER("LAST"))=0 ABMER("LAST")=(ABMT("XCNT")-1)
S ABMT("XCNT")=0
S ABMER("CNT")=0 ;abm*2.6*8
F S ABMT("XCNT")=$O(ABMT("XLIST",ABMT("XCNT"))) Q:'ABMT("XCNT") D
.S ABMT("XMIT")=0
.F S ABMT("XMIT")=$O(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT"))) Q:'ABMT("XMIT") D
..;I $D(ABMP("XLIST",ABMT("XCNT"),ABMP("XMIT")))<11 D Q ;this is for entries created prior to p6 install ;abm*2.6*8
..I $D(ABMP("XLIST",ABMT("XCNT"),ABMT("XMIT")))<11 D Q ;this is for entries created prior to p6 install ;abm*2.6*8
...;S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=ABMT("XCNT") ;abm*2.6*8
...S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=+$G(ABMER("CNT"))+1 ;abm*2.6*8
...K ABMP("INS") ;abm*2.6*8
...D CRBATCH
..S ABMT("SIEN")=0
..F S ABMT("SIEN")=$O(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT"),ABMT("SIEN"))) Q:'ABMT("SIEN") D
...S ABMT("GCN")=0
...F S ABMT("GCN")=$O(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT"),ABMT("SIEN"),ABMT("GCN"))) Q:'ABMT("GCN") D
....;S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=ABMT("XCNT") ;abm*2.6*8
....S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=+$G(ABMER("CNT"))+1 ;abm*2.6*8
....K ABMP("INS") ;abm*2.6*8
....D CRBATCH
K ABMP
K ABME
K ABMT
S DIR(0)="E"
D ^DIR
K DIR
Q
;end new code 5010
CRBATCH S ABMP("EXP")=$P(^ABMDTXST(DUZ(2),ABMP("XMIT"),0),"^",2)
S ABMP("XRTN")=$P($G(^ABMDEXP(+ABMP("EXP"),0)),"^",4)
S X=ABMP("XRTN")
X ^%ZOSF("TEST")
I '$T D K ABMP Q
.W !!,"Routine :",ABMP("XRTN")," not found.Cannot proceed.",!
.S DIR(0)="E"
.D ^DIR
.K DIR
;start old code abm*2.6*3 5PMS10005#2
;S DIE="^ABMDTXST(DUZ(2),"
;S DA=ABMP("XMIT")
;S DR=".16///"_$$NSN^ABMERUTL()
;D ^DIE
;end old code abm*2.6*3 5PMS10005#2
S ABMREX("RECREATE")=1 ;abm*2.6*2 5PMS10005
;D GCNMULT^ABMERUTL("C",1) ;abm*2.6*3 5PMS10005#2 ;abm*2.6*6 5010
I ABMER("CNT")=1 D GCNMULT^ABMERUTL("C",1) ;abm*2.6*3 5PMS10005#2 ;abm*2.6*6 5010
;start new code abm*2.6*8
I ABMER("CNT")>1 D
.S DA(1)=ABMP("XMIT")
.S DIC="^ABMDTXST(DUZ(2),"_DA(1)_",3,"
.S DIC("P")=$P(^DD(9002274.6,3,0),U,2)
.S DIC(0)="L"
.D NOW^%DTC
.S (X,ABMXMTDT)=%
.S DIC("DR")=".02////"_ABMGCN
.S DIC("DR")=DIC("DR")_";.03////C"
.S DIC("DR")=DIC("DR")_";.04////"_DUZ
.I +$G(ABM("CHIEN"))'=0 S DIC("DR")=DIC("DR")_";.07////"_+$G(ABM("CHIEN"))
.D ^DIC
;end new code abm*2.6*8
D @("^"_ABMP("XRTN"))
;start old code abm*2.6*6 5010
;S DIR(0)="E"
;D ^DIR
;K DIR
;K ABMP
;end old code abm*2.6*6 5010
Q
;start new code abm*2.6*6 5010
BATCHLST ;
W !
S ABME("XCNT")=0
F S ABME("XCNT")=$O(ABMP("XLIST",ABME("XCNT"))) Q:'ABME("XCNT") D
.S ABMP("XMIT")=0
.F S ABMP("XMIT")=$O(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT"))) Q:'ABMP("XMIT") D
..I $D(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT")))<11 D Q ;this is for entries created prior to p6 install
...S ABMPIT=$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,3)
...S ABMP("ITYP")=$S(ABMPIT="P":"PRIVATE",ABMPIT="D":"MEDICAID",ABMPIT="R":"MEDICARE",ABMPIT="N":"NON-BEN",ABMPIT="W":"WORK.COMP",ABMPIT="C":"CHAMPUS",1:"ALL SOURCES")
...W ABME("XCNT"),?3,$$BDT^ABMDUTL($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U)),?23,ABMP("GCN")
...W ?30,$P($G(^ABMDEXP($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,2),0)),U)
...W ?47,ABMP("ITYP")
...W:$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7) ?59,$P($G(^ABMRECVR($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7),0)),U)
...W !?23,$P($G(^AUTNINS($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,4),0)),U)
...W ?46,$P($G(^VA(200,$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,5),0)),U)
...W:$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6) ?70,"ST02: ",$$FMT^ABMERUTL($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6),"4NR")
...W !
..S ABMP("SIEN")=0
..F S ABMP("SIEN")=$O(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT"),ABMP("SIEN"))) Q:'ABMP("SIEN") D
...S ABMP("GCN")=0
...F S ABMP("GCN")=$O(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT"),ABMP("SIEN"),ABMP("GCN"))) Q:'ABMP("GCN") D
....S ABMPIT=$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,3)
....S ABMP("ITYP")=$S(ABMPIT="P":"PRIVATE",ABMPIT="D":"MEDICAID",ABMPIT="R":"MEDICARE",ABMPIT="N":"NON-BEN",ABMPIT="W":"WORK.COMP",ABMPIT="C":"CHAMPUS",1:"ALL SOURCES")
....W ABME("XCNT"),?3,$$BDT^ABMDUTL($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U)),?23,ABMP("GCN")
....W ?30,$P($G(^ABMDEXP($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,2),0)),U)
....W ?47,ABMP("ITYP")
....W:$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7) ?59,$P($G(^ABMRECVR($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7),0)),U)
....W !?23,$P($G(^AUTNINS($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,4),0)),U)
....W ?46,$P($G(^VA(200,$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,5),0)),U)
....W:$P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6) ?70,"ST02: ",$$FMT^ABMERUTL($P($G(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6),"4NR")
....W !
Q
;end new code 5010
ABMERSND ; IHS/ASDST/DMJ - RE-SEND A BATCH OF BILLS ELECTRONIC FORMAT ;
+1 ;;2.6;IHS Third Party Billing System;**2,6,8**;NOV 12, 2009
+2 ;Original;DMJ;
+3 ; IHS/SD/SDR - abm*2.6*2 - 5PMS10005 - Set var for 3P Bill EXPORT NUMBER RE-EXPORT multiple
+4 ; IHS/SD/SDR - abm*2.6*6 - 5010 - Changes for clearinghouse
+5 ;
START ;START HERE
+1 WRITE !
+2 SET DIC="^ABMDTXST(DUZ(2),"
+3 SET DIC(0)="AEMQ"
+4 SET DIC("S")="I $L($P($G(^(1)),""^"",4))"
+5 DO ^DIC
+6 KILL DIC
+7 IF Y<0
QUIT
+8 SET ABMP("XMIT")=+Y
+9 ;start new code abm*2.6*6 5010
LIST ; EP
+1 WRITE !!,"Checking...",!
+2 KILL ABMT("XLIST")
+3 KILL ABMT("CHKLIST")
+4 SET ABMT("XCNT")=0
+5 SET ABMT("XLINE")=1
+6 ;look at last entry only
SET ABMT("SIEN")=$ORDER(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,9999999),-1)
+7 IF ABMT("SIEN")'=""
SET ABMT("ORIGGCN")=$PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMT("SIEN"),0)),U,2)
+8 IF $GET(ABMT("ORIGGCN"))=""
SET ABMT("ORIGGCN")=$PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),1)),U,6)
+9 ;
+10 SET ABMT("XMIT")=0
+11 FOR
SET ABMT("XMIT")=$ORDER(^ABMDTXST(DUZ(2),"EGCN",ABMT("ORIGGCN"),ABMT("XMIT")))
IF '+ABMT("XMIT")
QUIT
Begin DoDot:1
+12 ;look at last entry only
SET ABMT("SIEN")=$ORDER(^ABMDTXST(DUZ(2),ABMT("XMIT"),3,9999999),-1)
+13 IF ABMT("SIEN")'=""
SET ABMT("GCN")=$PIECE($GET(^ABMDTXST(DUZ(2),ABMT("XMIT"),3,ABMT("SIEN"),0)),U,2)
+14 IF $GET(ABMT("GCN"))=""
SET ABMT("GCN")=$PIECE($GET(^ABMDTXST(DUZ(2),ABMT("XMIT"),1)),U,6)
+15 IF (ABMT("GCN")'=ABMT("ORIGGCN"))
QUIT
+16 SET ABMT("CHKLIST",ABMT("XMIT"))=1
+17 SET ABMT("XLIST",ABMT("XLINE"),ABMT("XMIT"),ABMT("SIEN"),ABMT("GCN"))=""
+18 SET ABMT("GLIST",ABMT("GCN"))=""
+19 SET ABMT("XCNT")=+$GET(ABMT("XCNT"))+1
SET ABMT("XLINE")=+$GET(ABMT("XLINE"))+1
End DoDot:1
+20 IF '$DATA(ABMT("XLIST"))
Begin DoDot:1
+21 FOR
SET ABMT("XMIT")=$ORDER(^ABMDTXST(DUZ(2),"C",ABMT("ORIGGCN"),ABMT("XMIT")))
IF '+ABMT("XMIT")
QUIT
+22 IF $GET(ABMT("GCN"))=""
SET ABMT("GCN")=$PIECE($GET(^ABMDTXST(DUZ(2),ABMT("XMIT"),1)),U,6)
+23 IF (ABMT("GCN")'=ABMT("ORIGGCN"))
QUIT
+24 SET ABMT("CHKLIST",ABMT("XMIT"))=1
+25 SET ABMT("XLIST",ABMT("XLINE"),ABMT("XMIT"))=""
+26 SET ABMT("GLIST",ABMT("GCN"))=""
+27 SET ABMT("XCNT")=+$GET(ABMT("XCNT"))+1
SET ABMT("XLINE")=+$GET(ABMT("XLINE"))+1
End DoDot:1
+28 ;abm*2.6*8
SET ABMER("LAST")=+$GET(ABMT("XCNT"))
+29 ;
+30 IF +$GET(ABMT("XCNT"))>1
Begin DoDot:1
+31 WRITE !,"There are multiple batches associated with your selection."
+32 WRITE !!,"Select from the following:",!
End DoDot:1
+33 DO BATCHLST
+34 SET ABMQUIT=0
+35 IF +$GET(ABMT("XCNT"))>1
Begin DoDot:1
+36 KILL DIR,DIE,DIC,X,Y,DA
+37 SET DIR(0)="SO^1:All associated batches;2:A single batch entry;3:Reselect export dates;4:Quit"
+38 SET DIR("A")="Select"
+39 DO ^DIR
KILL DIR
+40 SET ABMANS=+Y
+41 ;print all entries
IF ABMANS=1
+42 ;select one entry
IF ABMANS=2
Begin DoDot:2
+43 DO BATCHLST
+44 KILL DIR,DIE,DIC,X,Y,DA
+45 SET DIR(0)="NO^1:"_(ABMT("XCNT")-1)
+46 SET DIR("A")="Select"
+47 DO ^DIR
KILL DIR
+48 IF +Y=0
SET ABMQUIT=1
+49 SET ABMSEL=Y
End DoDot:2
+50 ;start over
IF ABMANS=3
GOTO START
+51 ;quit w/out printing anything
IF ABMANS=4
SET ABMQUIT=1
QUIT
End DoDot:1
+52 IF ABMQUIT
QUIT
+53 IF $GET(ABMANS)=2
Begin DoDot:1
+54 SET ABMT("XCNT")=ABMSEL
+55 SET ABMECHK=0
+56 FOR
SET ABMECHK=$ORDER(ABMT("XLIST",ABMECHK))
IF 'ABMECHK
QUIT
Begin DoDot:2
+57 IF ABMECHK'=ABMSEL
KILL ABMT("XLIST",ABMECHK)
End DoDot:2
+58 MERGE ABMT("XLIST",1)=ABMT("XLIST",ABMSEL)
+59 SET (ABMER("CNT"),ABMER("LAST"))=1
End DoDot:1
+60 ;
+61 IF +$GET(ABMER("LAST"))=0
SET ABMER("LAST")=(ABMT("XCNT")-1)
+62 SET ABMT("XCNT")=0
+63 ;abm*2.6*8
SET ABMER("CNT")=0
+64 FOR
SET ABMT("XCNT")=$ORDER(ABMT("XLIST",ABMT("XCNT")))
IF 'ABMT("XCNT")
QUIT
Begin DoDot:1
+65 SET ABMT("XMIT")=0
+66 FOR
SET ABMT("XMIT")=$ORDER(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT")))
IF 'ABMT("XMIT")
QUIT
Begin DoDot:2
+67 ;I $D(ABMP("XLIST",ABMT("XCNT"),ABMP("XMIT")))<11 D Q ;this is for entries created prior to p6 install ;abm*2.6*8
+68 ;this is for entries created prior to p6 install ;abm*2.6*8
IF $DATA(ABMP("XLIST",ABMT("XCNT"),ABMT("XMIT")))<11
Begin DoDot:3
+69 ;S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=ABMT("XCNT") ;abm*2.6*8
+70 ;abm*2.6*8
SET ABMP("XMIT")=ABMT("XMIT")
SET ABMER("CNT")=+$GET(ABMER("CNT"))+1
+71 ;abm*2.6*8
KILL ABMP("INS")
+72 DO CRBATCH
End DoDot:3
QUIT
+73 SET ABMT("SIEN")=0
+74 FOR
SET ABMT("SIEN")=$ORDER(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT"),ABMT("SIEN")))
IF 'ABMT("SIEN")
QUIT
Begin DoDot:3
+75 SET ABMT("GCN")=0
+76 FOR
SET ABMT("GCN")=$ORDER(ABMT("XLIST",ABMT("XCNT"),ABMT("XMIT"),ABMT("SIEN"),ABMT("GCN")))
IF 'ABMT("GCN")
QUIT
Begin DoDot:4
+77 ;S ABMP("XMIT")=ABMT("XMIT"),ABMER("CNT")=ABMT("XCNT") ;abm*2.6*8
+78 ;abm*2.6*8
SET ABMP("XMIT")=ABMT("XMIT")
SET ABMER("CNT")=+$GET(ABMER("CNT"))+1
+79 ;abm*2.6*8
KILL ABMP("INS")
+80 DO CRBATCH
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+81 KILL ABMP
+82 KILL ABME
+83 KILL ABMT
+84 SET DIR(0)="E"
+85 DO ^DIR
+86 KILL DIR
+87 QUIT
+88 ;end new code 5010
CRBATCH SET ABMP("EXP")=$PIECE(^ABMDTXST(DUZ(2),ABMP("XMIT"),0),"^",2)
+1 SET ABMP("XRTN")=$PIECE($GET(^ABMDEXP(+ABMP("EXP"),0)),"^",4)
+2 SET X=ABMP("XRTN")
+3 XECUTE ^%ZOSF("TEST")
+4 IF '$TEST
Begin DoDot:1
+5 WRITE !!,"Routine :",ABMP("XRTN")," not found.Cannot proceed.",!
+6 SET DIR(0)="E"
+7 DO ^DIR
+8 KILL DIR
End DoDot:1
KILL ABMP
QUIT
+9 ;start old code abm*2.6*3 5PMS10005#2
+10 ;S DIE="^ABMDTXST(DUZ(2),"
+11 ;S DA=ABMP("XMIT")
+12 ;S DR=".16///"_$$NSN^ABMERUTL()
+13 ;D ^DIE
+14 ;end old code abm*2.6*3 5PMS10005#2
+15 ;abm*2.6*2 5PMS10005
SET ABMREX("RECREATE")=1
+16 ;D GCNMULT^ABMERUTL("C",1) ;abm*2.6*3 5PMS10005#2 ;abm*2.6*6 5010
+17 ;abm*2.6*3 5PMS10005#2 ;abm*2.6*6 5010
IF ABMER("CNT")=1
DO GCNMULT^ABMERUTL("C",1)
+18 ;start new code abm*2.6*8
+19 IF ABMER("CNT")>1
Begin DoDot:1
+20 SET DA(1)=ABMP("XMIT")
+21 SET DIC="^ABMDTXST(DUZ(2),"_DA(1)_",3,"
+22 SET DIC("P")=$PIECE(^DD(9002274.6,3,0),U,2)
+23 SET DIC(0)="L"
+24 DO NOW^%DTC
+25 SET (X,ABMXMTDT)=%
+26 SET DIC("DR")=".02////"_ABMGCN
+27 SET DIC("DR")=DIC("DR")_";.03////C"
+28 SET DIC("DR")=DIC("DR")_";.04////"_DUZ
+29 IF +$GET(ABM("CHIEN"))'=0
SET DIC("DR")=DIC("DR")_";.07////"_+$GET(ABM("CHIEN"))
+30 DO ^DIC
End DoDot:1
+31 ;end new code abm*2.6*8
+32 DO @("^"_ABMP("XRTN"))
+33 ;start old code abm*2.6*6 5010
+34 ;S DIR(0)="E"
+35 ;D ^DIR
+36 ;K DIR
+37 ;K ABMP
+38 ;end old code abm*2.6*6 5010
+39 QUIT
+40 ;start new code abm*2.6*6 5010
BATCHLST ;
+1 WRITE !
+2 SET ABME("XCNT")=0
+3 FOR
SET ABME("XCNT")=$ORDER(ABMP("XLIST",ABME("XCNT")))
IF 'ABME("XCNT")
QUIT
Begin DoDot:1
+4 SET ABMP("XMIT")=0
+5 FOR
SET ABMP("XMIT")=$ORDER(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT")))
IF 'ABMP("XMIT")
QUIT
Begin DoDot:2
+6 ;this is for entries created prior to p6 install
IF $DATA(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT")))<11
Begin DoDot:3
+7 SET ABMPIT=$PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,3)
+8 SET ABMP("ITYP")=$SELECT(ABMPIT="P":"PRIVATE",ABMPIT="D":"MEDICAID",ABMPIT="R":"MEDICARE",ABMPIT="N":"NON-BEN",ABMPIT="W":"WORK.COMP",ABMPIT="C":"CHAMPUS",1:"ALL SOURCES")
+9 WRITE ABME("XCNT"),?3,$$BDT^ABMDUTL($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U)),?23,ABMP("GCN")
+10 WRITE ?30,$PIECE($GET(^ABMDEXP($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,2),0)),U)
+11 WRITE ?47,ABMP("ITYP")
+12 IF $PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7)
WRITE ?59,$PIECE($GET(^ABMRECVR($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7),0)),U)
+13 WRITE !?23,$PIECE($GET(^AUTNINS($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,4),0)),U)
+14 WRITE ?46,$PIECE($GET(^VA(200,$PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,5),0)),U)
+15 IF $PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6)
WRITE ?70,"ST02: ",$$FMT^ABMERUTL($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6),"4NR")
+16 WRITE !
End DoDot:3
QUIT
+17 SET ABMP("SIEN")=0
+18 FOR
SET ABMP("SIEN")=$ORDER(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT"),ABMP("SIEN")))
IF 'ABMP("SIEN")
QUIT
Begin DoDot:3
+19 SET ABMP("GCN")=0
+20 FOR
SET ABMP("GCN")=$ORDER(ABMP("XLIST",ABME("XCNT"),ABMP("XMIT"),ABMP("SIEN"),ABMP("GCN")))
IF 'ABMP("GCN")
QUIT
Begin DoDot:4
+21 SET ABMPIT=$PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,3)
+22 SET ABMP("ITYP")=$SELECT(ABMPIT="P":"PRIVATE",ABMPIT="D":"MEDICAID",ABMPIT="R":"MEDICARE",ABMPIT="N":"NON-BEN",ABMPIT="W":"WORK.COMP",ABMPIT="C":"CHAMPUS",1:"ALL SOURCES")
+23 WRITE ABME("XCNT"),?3,$$BDT^ABMDUTL($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U)),?23,ABMP("GCN")
+24 WRITE ?30,$PIECE($GET(^ABMDEXP($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,2),0)),U)
+25 WRITE ?47,ABMP("ITYP")
+26 IF $PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7)
WRITE ?59,$PIECE($GET(^ABMRECVR($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,7),0)),U)
+27 WRITE !?23,$PIECE($GET(^AUTNINS($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,4),0)),U)
+28 WRITE ?46,$PIECE($GET(^VA(200,$PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),0)),U,5),0)),U)
+29 IF $PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6)
WRITE ?70,"ST02: ",$$FMT^ABMERUTL($PIECE($GET(^ABMDTXST(DUZ(2),ABMP("XMIT"),3,ABMP("SIEN"),0)),U,6),"4NR")
+30 WRITE !
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;end new code 5010
