ABMDREX1 ; IHS/SD/SDR - Re-Create batch of Selected Bills ;
;;2.6;IHS Third Party Billing System;**2,3,4,6,10,14,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR 2.6*21 - split routine from ABMDREEX
;IHS/SD/SDR 2.6*21 HEAT207484 Made change to stop error <UNDEF>EXPMODE+66^ABMDREEX when no bills meet selected criteria
;
ZIS ;EP
;start new abm*2.6*3
S ABMBIEN=0,ABMDFLG=0
F S ABMBIEN=$O(^TMP($J,"ABM-D-DUP",ABMBIEN)) Q:(+$G(ABMBIEN)=0) D
.I $G(^TMP($J,"ABM-D-DUP",ABMBIEN))>1 S ABMDFLG=1
I ABMDFLG=1 W !!?2,"Duplicate bills exist in this selection. If re-exported the bill will only",!?2,"be included once."
;end new abm*2.6*3
S DIR(0)="Y"
S DIR("A",1)=""
S DIR("A",2)=""
I $G(ABMREX("SELINS"))'="" D
.S DIR("A",3)="One file will be created for each visit location/visit type/export mode"
.S DIR("A",4)="combination with a maximum of 1000 bills in each file"
.S DIR("A",5)=""
I $G(ABMREX("SELINS"))="" S DIR("A",3)="A file will be created for the bills selected",DIR("A",4)=""
S DIR("A")="Proceed"
S DIR("B")="YES"
D ^DIR
K DIR
;I Y'=1 K ABME Q ;abm*2.6*3
I Y'=1 D Q:Y=1
.W !!
.K X,Y,DIR,DIE,DIC,DA
.S DIR(0)="Y"
.S DIR("A",1)="Your selection of bills will be lost."
.S DIR("A")="Are you sure you wish to exit"
.S DIR("B")="NO"
.D ^DIR
.K DIR
;
;selected bills-one filename
I $G(ABMREX("SELINS"))="" D
.S ABMEXP=ABMT("EXP")
.S ABMREX("BILLSELECT")=1
.;start new abm*2.6*3 ;abm*2.6*3 FIXPMS10005
.S ABMY("TOT")=0
.S ABMREX("BDFN")=0
.F S ABMREX("BDFN")=$O(ABMY(ABMREX("BDFN"))) Q:(+$G(ABMREX("BDFN"))=0) D
..S ABMY("INS")=$P($G(^ABMDBILL(DUZ(2),ABMREX("BDFN"),0)),U,8)
..S ABMY("VTYP")=$P($G(^ABMDBILL(DUZ(2),ABMREX("BDFN"),0)),U,7)
..S ABMY("EXP")=$P($G(^ABMDBILL(DUZ(2),ABMREX("BDFN"),0)),U,6)
..S ABMY("LOC")=$P($G(^AUTTLOC(DUZ(2),0)),U,2)
..S ABMY("TOT")=+$G(ABMY("TOT"))+$P($G(^ABMDBILL(DUZ(2),ABMREX("BDFN"),2)),U)
..S ^TMP($J,"D",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"),ABMY("EXP"),ABMREX("BDFN"))=""
.;end new abm*2.6*3 ;abm*2.6*3 FIXPMS10005
.D CREATEN^ABMDREEX
.;
;exports selected - one filename for ea export
I $G(ABMREX("SELINS"))'="" D
.S ABMREX("BATCHSELECT")=1
.;start new abm*2.6*3 FIXPMS10005
.S ABMFCNT=1
.S ABMY("INS")=0
.F S ABMY("INS")=$O(^TMP($J,"ABM-REEX",ABMY("INS"))) Q:'ABMY("INS") D
..S ABMINS("IEN")=ABMY("INS")
..S ABMY("LOC")=0
..F S ABMY("LOC")=$O(^TMP($J,"ABM-REEX",ABMY("INS"),ABMY("LOC"))) Q:'ABMY("LOC") D
...S ABMY("LOC1")=$P($G(^AUTTLOC(ABMY("LOC"),0)),U,2)_"@"_ABMY("LOC")
...S ABMY("VTYP")=0
...F S ABMY("VTYP")=$O(^TMP($J,"ABM-REEX",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"))) Q:'ABMY("VTYP") D
....S ABMY("EXP")=0
....F S ABMY("EXP")=$O(^TMP($J,"ABM-REEX",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"),ABMY("EXP"))) Q:'ABMY("EXP") D
.....S ABMEXP=ABMY("EXP")
.....S ABMBDFN=0
.....S ABMCNT=0
.....S ABMY("TOT")=0
.....F S ABMBDFN=$O(^TMP($J,"ABM-REEX",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"),ABMY("EXP"),ABMBDFN)) Q:'ABMBDFN D
......S ABMCNT=+$G(ABMCNT)+1
......S ABMY("TOT")=+$G(ABMY("TOT"))+$P($G(^ABMDBILL(DUZ(2),ABMBDFN,2)),U)
.....S ABMREX("CNTS",ABMY("EXP"),ABMCNT)=""
.....W !!,"Creating file # ",ABMFCNT
.....S ABMFCNT=+$G(ABMFCNT)+1
.....M ^TMP($J,"D",ABMY("INS"),ABMY("LOC1"),ABMY("VTYP"),ABMY("EXP"))=^TMP($J,"ABM-REEX",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"),ABMY("EXP"))
.....W !,?15,$P(^ABMDEXP(ABMY("EXP"),0),U),?35,"VISIT TYPE: "_ABMY("VTYP"),?55,ABMCNT_" "_$S(ABMCNT=1:"Bill",1:"Bills"),?68,$J($FN(ABMY("TOT"),",",2),10)
.....K ABMXMTDT ;abm*2.6*3 5PMS10005#2
.....D CREATEN^ABMDREEX
.....K ^TMP($J,"D")
.;end new abm*2.6*3 FIXPMS10005
S DIR(0)="E"
D ^DIR
K DIR
W !!
Q
ABMDREX1 ; IHS/SD/SDR - Re-Create batch of Selected Bills ;
+1 ;;2.6;IHS Third Party Billing System;**2,3,4,6,10,14,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR 2.6*21 - split routine from ABMDREEX
+3 ;IHS/SD/SDR 2.6*21 HEAT207484 Made change to stop error <UNDEF>EXPMODE+66^ABMDREEX when no bills meet selected criteria
+4 ;
ZIS ;EP
+1 ;start new abm*2.6*3
+2 SET ABMBIEN=0
SET ABMDFLG=0
+3 FOR
SET ABMBIEN=$ORDER(^TMP($JOB,"ABM-D-DUP",ABMBIEN))
IF (+$GET(ABMBIEN)=0)
QUIT
Begin DoDot:1
+4 IF $GET(^TMP($JOB,"ABM-D-DUP",ABMBIEN))>1
SET ABMDFLG=1
End DoDot:1
+5 IF ABMDFLG=1
WRITE !!?2,"Duplicate bills exist in this selection. If re-exported the bill will only",!?2,"be included once."
+6 ;end new abm*2.6*3
+7 SET DIR(0)="Y"
+8 SET DIR("A",1)=""
+9 SET DIR("A",2)=""
+10 IF $GET(ABMREX("SELINS"))'=""
Begin DoDot:1
+11 SET DIR("A",3)="One file will be created for each visit location/visit type/export mode"
+12 SET DIR("A",4)="combination with a maximum of 1000 bills in each file"
+13 SET DIR("A",5)=""
End DoDot:1
+14 IF $GET(ABMREX("SELINS"))=""
SET DIR("A",3)="A file will be created for the bills selected"
SET DIR("A",4)=""
+15 SET DIR("A")="Proceed"
+16 SET DIR("B")="YES"
+17 DO ^DIR
+18 KILL DIR
+19 ;I Y'=1 K ABME Q ;abm*2.6*3
+20 IF Y'=1
Begin DoDot:1
+21 WRITE !!
+22 KILL X,Y,DIR,DIE,DIC,DA
+23 SET DIR(0)="Y"
+24 SET DIR("A",1)="Your selection of bills will be lost."
+25 SET DIR("A")="Are you sure you wish to exit"
+26 SET DIR("B")="NO"
+27 DO ^DIR
+28 KILL DIR
End DoDot:1
IF Y=1
QUIT
+29 ;
+30 ;selected bills-one filename
+31 IF $GET(ABMREX("SELINS"))=""
Begin DoDot:1
+32 SET ABMEXP=ABMT("EXP")
+33 SET ABMREX("BILLSELECT")=1
+34 ;start new abm*2.6*3 ;abm*2.6*3 FIXPMS10005
+35 SET ABMY("TOT")=0
+36 SET ABMREX("BDFN")=0
+37 FOR
SET ABMREX("BDFN")=$ORDER(ABMY(ABMREX("BDFN")))
IF (+$GET(ABMREX("BDFN"))=0)
QUIT
Begin DoDot:2
+38 SET ABMY("INS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMREX("BDFN"),0)),U,8)
+39 SET ABMY("VTYP")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMREX("BDFN"),0)),U,7)
+40 SET ABMY("EXP")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMREX("BDFN"),0)),U,6)
+41 SET ABMY("LOC")=$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)
+42 SET ABMY("TOT")=+$GET(ABMY("TOT"))+$PIECE($GET(^ABMDBILL(DUZ(2),ABMREX("BDFN"),2)),U)
+43 SET ^TMP($JOB,"D",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"),ABMY("EXP"),ABMREX("BDFN"))=""
End DoDot:2
+44 ;end new abm*2.6*3 ;abm*2.6*3 FIXPMS10005
+45 DO CREATEN^ABMDREEX
+46 ;
End DoDot:1
+47 ;exports selected - one filename for ea export
+48 IF $GET(ABMREX("SELINS"))'=""
Begin DoDot:1
+49 SET ABMREX("BATCHSELECT")=1
+50 ;start new abm*2.6*3 FIXPMS10005
+51 SET ABMFCNT=1
+52 SET ABMY("INS")=0
+53 FOR
SET ABMY("INS")=$ORDER(^TMP($JOB,"ABM-REEX",ABMY("INS")))
IF 'ABMY("INS")
QUIT
Begin DoDot:2
+54 SET ABMINS("IEN")=ABMY("INS")
+55 SET ABMY("LOC")=0
+56 FOR
SET ABMY("LOC")=$ORDER(^TMP($JOB,"ABM-REEX",ABMY("INS"),ABMY("LOC")))
IF 'ABMY("LOC")
QUIT
Begin DoDot:3
+57 SET ABMY("LOC1")=$PIECE($GET(^AUTTLOC(ABMY("LOC"),0)),U,2)_"@"_ABMY("LOC")
+58 SET ABMY("VTYP")=0
+59 FOR
SET ABMY("VTYP")=$ORDER(^TMP($JOB,"ABM-REEX",ABMY("INS"),ABMY("LOC"),ABMY("VTYP")))
IF 'ABMY("VTYP")
QUIT
Begin DoDot:4
+60 SET ABMY("EXP")=0
+61 FOR
SET ABMY("EXP")=$ORDER(^TMP($JOB,"ABM-REEX",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"),ABMY("EXP")))
IF 'ABMY("EXP")
QUIT
Begin DoDot:5
+62 SET ABMEXP=ABMY("EXP")
+63 SET ABMBDFN=0
+64 SET ABMCNT=0
+65 SET ABMY("TOT")=0
+66 FOR
SET ABMBDFN=$ORDER(^TMP($JOB,"ABM-REEX",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"),ABMY("EXP"),ABMBDFN))
IF 'ABMBDFN
QUIT
Begin DoDot:6
+67 SET ABMCNT=+$GET(ABMCNT)+1
+68 SET ABMY("TOT")=+$GET(ABMY("TOT"))+$PIECE($GET(^ABMDBILL(DUZ(2),ABMBDFN,2)),U)
End DoDot:6
+69 SET ABMREX("CNTS",ABMY("EXP"),ABMCNT)=""
+70 WRITE !!,"Creating file # ",ABMFCNT
+71 SET ABMFCNT=+$GET(ABMFCNT)+1
+72 MERGE ^TMP($JOB,"D",ABMY("INS"),ABMY("LOC1"),ABMY("VTYP"),ABMY("EXP"))=^TMP($JOB,"ABM-REEX",ABMY("INS"),ABMY("LOC"),ABMY("VTYP"),ABMY("EXP"))
+73 WRITE !,?15,$PIECE(^ABMDEXP(ABMY("EXP"),0),U),?35,"VISIT TYPE: "_ABMY("VTYP"),?55,ABMCNT_" "_$SELECT(ABMCNT=1:"Bill",1:"Bills"),?68,$JUSTIFY($FNUMBER(ABMY("TOT"),",",2),10)
+74 ;abm*2.6*3 5PMS10005#2
KILL ABMXMTDT
+75 DO CREATEN^ABMDREEX
+76 KILL ^TMP($JOB,"D")
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+77 ;end new abm*2.6*3 FIXPMS10005
End DoDot:1
+78 SET DIR(0)="E"
+79 DO ^DIR
+80 KILL DIR
+81 WRITE !!
+82 QUIT
