- 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
