ABMEMCRC ; IHS/SD/SDR - 3PB recreate batch of ICD9 bills
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p12 - New routine
; Recreate batches for specified insurer that meet selection criteria
;
EP ;
W !!,"This option will create a batch of claims that meet the following criteria:"
W !?5,"* Bill type is 11* where * is any number"
W !?5,"* The bill contains ICD Procedure codes"
W !?5,"* Bill status is NOT cancelled"
W !?5,"* 837I export mode only"
W !
W !,"You will be asked the following to complete the selection criteria:"
W !?5,"* Insurer (multiple entries not allowed)"
W !?5,"* Date range (either by approval, batch, or visit date)"
W !?5,"* Resubmission note that will be put on ALL claims"
W !
S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;
INSURER D EN^ABMVDF("IOF")
S DIC="^AUTNINS("
S DIC(0)="AEMQ"
D ^DIC
Q:+Y<0
I +Y>0 S ABMINS=+Y
;
WHATDT ;
K DIR
S DIR("A")="Apply range to"
S DIR(0)="SO^A:APPROVAL DATE;B:BATCH DATE;V:VISIT DATE"
D ^DIR
G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) INSURER
S ABMFILE=Y
;
FROMDT ;
K DIR
S DIR("A")="Enter FROM date"
S DIR(0)="D"
D ^DIR
Q:'Y
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABMFROM=+Y
TODT ;
K DIR
S DIR("A")="Enter TO date"
S DIR(0)="D"
D ^DIR
Q:'Y
G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) FROMDT
S ABMTO=+Y
I ABMTO<ABMFROM W !!,"TO DATE CAN'T BE AFTER FROM DATE",! G FROMDT
;
RESUBN ;
K DIR
S DIR("A")="Resubmission note"
S DIR(0)="F^3:80"
D ^DIR
G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) FROMDT
S ABMRESUB=Y
;
MSG ;
W !!,"Bills meeting the following criteria will be recreated in a new batch:"
W !?5,"* Bill type is 11* where * is any number"
W !?5,"* The bill contains ICD Procedure codes"
W !?5,"* Bill status is NOT cancelled"
W !?5,"* 837I export mode only"
W !
W !?5,"* Active insurer is ",$P($G(^AUTNINS(ABMINS,0)),U)
W !?5,"* ",$S(ABMFILE="B":"Batches created",ABMFILE="V":"Visit dates",1:"Bills approved")
W " between "_$$SDT^ABMDUTL(ABMFROM)_" and "_$$SDT^ABMDUTL(ABMTO)
W !?5,"* With the resubmission note: ",ABMRESUB
W !
S DIR(0)="Y",DIR("A")="Do you wish to continue" D ^DIR K DIR
Q:Y'=1
I ABMFILE="A" D ALOOP
I ABMFILE="B" D BLOOP
I ABMFILE="V" D VLOOP
D OUTPUT
S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
D XIT
Q
;
ALOOP ;
K ABMB
S ABMDT=ABMFROM-.5
S ABMTO=ABMTO+1
F S ABMDT=$O(^ABMDBILL(DUZ(2),"AP",ABMDT)) Q:+ABMDT=0!(ABMDT>ABMTO) D
.S ABMBDFN=0
.F S ABMBDFN=$O(^ABMDBILL(DUZ(2),"AP",ABMDT,ABMBDFN)) Q:+ABMBDFN=0 D
..D BILLCK
Q
BLOOP ;
K ABMB
S ABMDT=ABMFROM-.5
S ABMTO=ABMTO+1
F S ABMDT=$O(^ABMDTXST(DUZ(2),"B",ABMDT)) Q:+ABMDT=0!(ABMDT>ABMTO) D
.S ABMTIEN=0
.F S ABMTIEN=$O(^ABMDTXST(DUZ(2),"B",ABMDT,ABMTIEN)) Q:+ABMTIEN=0 D
..Q:$P($G(^ABMDTXST(DUZ(2),ABMTIEN,1)),U,4)="" ;EMC FILENAME
..S ABMBDFN=0
..F S ABMBDFN=$O(^ABMDTXST(DUZ(2),ABMTIEN,2,ABMBDFN)) Q:+ABMBDFN=0 D
...D BILLCK
Q
VLOOP ;
K ABMB
S ABMDT=ABMFROM-.5
S ABMTO=ABMTO+1
F S ABMDT=$O(^ABMDBILL(DUZ(2),"AD",ABMDT)) Q:+ABMDT=0!(ABMDT>ABMTO) D
.S ABMBDFN=0
.F S ABMBDFN=$O(^ABMDBILL(DUZ(2),"AD",ABMDT,ABMBDFN)) Q:+ABMBDFN=0 D
..D BILLCK
Q
BILLCK ;
Q:($E($P($G(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,2),1,2)'=11) ;bill type
Q:$P($G(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,4)="X" ;bill status-cancelled
Q:$P($G(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,8)'=ABMINS ;insurer selected
Q:'$D(^ABMDBILL(DUZ(2),ABMBDFN,19,0)) ;ICD procedures
S ABMEXPM=$P($G(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,6) ;export mode
Q:$G(ABMEXPM)'=21 ;837I only
S ABMB(ABMEXPM,ABMBDFN)=""
Q
OUTPUT ;
S ABMINS("IEN")=ABMINS ;Active Insurer IEN
S ABMITYP=$P(^AUTNINS(ABMINS("IEN"),2),U) ;Insurer type
S ABMEXP=21 ;export type
D NEWB ; Create a new batch in 3P TX STATUS
I $G(Y)<0 D MSG^ABMERUTL("Could not enter batch in 3P TX STATUS file.") Q
; Add bill to detail in 3P TX STATUS for this batch
S ^ABMDTXST(DUZ(2),DA(1),2,0)="^9002274.61P^^"
S ABMAPOK=1
S ABMDA=0
F S ABMDA=$O(ABMB(21,ABMDA)) Q:+ABMDA=0 D
.S X=ABMDA
.S DIC="^ABMDTXST(DUZ(2),DA(1),2,"
.S DIC(0)="LXNE"
.S DINUM=X
.K DD,DO D FILE^DICN
.Q:+Y<0
.S DA=+Y
.S DIE="^ABMDTXST(DUZ(2),DA(1),2,"
.S ABMAPRV=$O(^ABMDBILL(DUZ(2),ABMDA,41,"C","A",0))
.S:ABMAPRV ABMAPRV=$P(^ABMDBILL(DUZ(2),ABMDA,41,ABMAPRV,0),U)
.I ABMAPRV D
..S DR=".02///`"_ABMAPRV
..D ^DIE
..K ABMAPRV
.S ABMSBR=$$SBR^ABMUTLP(ABMDA)
.S DR=".03///"_ABMSBR
.D ^DIE
.K ABMSBR
K ABMAPOK
; Write record (Create EMC unix file)
D ^ABMEF21
I $G(POP) D
.S DIE="^ABMDTXST(DUZ(2),"
.S DA=ABMP("XMIT")
.S DR=".14///NOPEN"
.D ^DIE
Q
NEWB ;
; Create a new batch (Make entry in 3P TX STATUS)
D NOW^%DTC
S X=%
S DIC="^ABMDTXST(DUZ(2),"
S DIC(0)="LX"
S DLAYGO=9002274.6
K DD,DO D FILE^DICN
K DLAYGO
Q:Y<0
S ABMP("XMIT")=+Y
S DIE=DIC
S DA=+Y
S DR=".02///21;.04///`"_ABMINS("IEN")_";.03///"_ABMITYP_";.05////"_DUZ
D ^DIE
S DR=".16///"_$$NSN^ABMERUTL D ^DIE
S DA(1)=DA
W !,"ENTRY CREATED IN 3P TX STATUS FILE."
Q
CLAIM ;one claim
K ABMP
S ABMP("INS")=ABMINS
S ABMP("ITYPE")=$P($G(^AUTNINS(ABMINS,2)),U)
S ABMP("BDFN")=ABMBDFN
Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
D SET^ABMUTLP(ABMP("BDFN"))
I '$G(ABMOSBR) D
.U 0 W !,"Submission # ",ABMSUBN
.U 0 W !,"Writing bills to file.",!
.D ^ABME8L1
.D ^ABME8L2
S ABMNPDFN=$P(ABMB0,U,5)
I ABMOSBR'=ABMASBR D
.D SBR
I ABMNPDFN'=ABMOPDFN D
.D PTCHG^ABME8L3
S ABMP("PNUM")=$$PNUM^ABMUTLP(ABMBILL)
D ^ABME8L5
D ^ABME8L6
D ^ABME8L7
D ^ABME8L8
D ^ABME8L10
W "."
Q
SBR ;new subscriber
S ABMSFILE=$P(ABMASBR,"-",1)
S ABMSIEN=$P(ABMASBR,"-",2)
S ABMCHILD=0
N I
S I=0
F S I=$O(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,I)) Q:'I D
.Q:+^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,I)=18
.S ABMCHILD=1
S ABMP("PNUM")=$$PNUM^ABMUTLP(ABMBILL)
D ^ABME8L3
S ABMOSBR=ABMASBR
S ABMOPDFN=ABMP("PDFN")
Q
XIT ;
D ^%ZISC
W !!,"Finished.",!!
K ABMEXPM,ABMBDFN,ABMB,ABMTIEN,ABMFROM,ABMTO,ABMDT
K ABMFILE,ABMRESUB,ABMINS
Q
ABMEMCRC ; IHS/SD/SDR - 3PB recreate batch of ICD9 bills
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p12 - New routine
+4 ; Recreate batches for specified insurer that meet selection criteria
+5 ;
EP ;
+1 WRITE !!,"This option will create a batch of claims that meet the following criteria:"
+2 WRITE !?5,"* Bill type is 11* where * is any number"
+3 WRITE !?5,"* The bill contains ICD Procedure codes"
+4 WRITE !?5,"* Bill status is NOT cancelled"
+5 WRITE !?5,"* 837I export mode only"
+6 WRITE !
+7 WRITE !,"You will be asked the following to complete the selection criteria:"
+8 WRITE !?5,"* Insurer (multiple entries not allowed)"
+9 WRITE !?5,"* Date range (either by approval, batch, or visit date)"
+10 WRITE !?5,"* Resubmission note that will be put on ALL claims"
+11 WRITE !
+12 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+13 ;
INSURER DO EN^ABMVDF("IOF")
+1 SET DIC="^AUTNINS("
+2 SET DIC(0)="AEMQ"
+3 DO ^DIC
+4 IF +Y<0
QUIT
+5 IF +Y>0
SET ABMINS=+Y
+6 ;
WHATDT ;
+1 KILL DIR
+2 SET DIR("A")="Apply range to"
+3 SET DIR(0)="SO^A:APPROVAL DATE;B:BATCH DATE;V:VISIT DATE"
+4 DO ^DIR
+5 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO INSURER
+6 SET ABMFILE=Y
+7 ;
FROMDT ;
+1 KILL DIR
+2 SET DIR("A")="Enter FROM date"
+3 SET DIR(0)="D"
+4 DO ^DIR
+5 IF 'Y
QUIT
+6 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+7 SET ABMFROM=+Y
TODT ;
+1 KILL DIR
+2 SET DIR("A")="Enter TO date"
+3 SET DIR(0)="D"
+4 DO ^DIR
+5 IF 'Y
QUIT
+6 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO FROMDT
+7 SET ABMTO=+Y
+8 IF ABMTO<ABMFROM
WRITE !!,"TO DATE CAN'T BE AFTER FROM DATE",!
GOTO FROMDT
+9 ;
RESUBN ;
+1 KILL DIR
+2 SET DIR("A")="Resubmission note"
+3 SET DIR(0)="F^3:80"
+4 DO ^DIR
+5 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO FROMDT
+6 SET ABMRESUB=Y
+7 ;
MSG ;
+1 WRITE !!,"Bills meeting the following criteria will be recreated in a new batch:"
+2 WRITE !?5,"* Bill type is 11* where * is any number"
+3 WRITE !?5,"* The bill contains ICD Procedure codes"
+4 WRITE !?5,"* Bill status is NOT cancelled"
+5 WRITE !?5,"* 837I export mode only"
+6 WRITE !
+7 WRITE !?5,"* Active insurer is ",$PIECE($GET(^AUTNINS(ABMINS,0)),U)
+8 WRITE !?5,"* ",$SELECT(ABMFILE="B":"Batches created",ABMFILE="V":"Visit dates",1:"Bills approved")
+9 WRITE " between "_$$SDT^ABMDUTL(ABMFROM)_" and "_$$SDT^ABMDUTL(ABMTO)
+10 WRITE !?5,"* With the resubmission note: ",ABMRESUB
+11 WRITE !
+12 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
DO ^DIR
KILL DIR
+13 IF Y'=1
QUIT
+14 IF ABMFILE="A"
DO ALOOP
+15 IF ABMFILE="B"
DO BLOOP
+16 IF ABMFILE="V"
DO VLOOP
+17 DO OUTPUT
+18 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
+19 DO XIT
+20 QUIT
+21 ;
ALOOP ;
+1 KILL ABMB
+2 SET ABMDT=ABMFROM-.5
+3 SET ABMTO=ABMTO+1
+4 FOR
SET ABMDT=$ORDER(^ABMDBILL(DUZ(2),"AP",ABMDT))
IF +ABMDT=0!(ABMDT>ABMTO)
QUIT
Begin DoDot:1
+5 SET ABMBDFN=0
+6 FOR
SET ABMBDFN=$ORDER(^ABMDBILL(DUZ(2),"AP",ABMDT,ABMBDFN))
IF +ABMBDFN=0
QUIT
Begin DoDot:2
+7 DO BILLCK
End DoDot:2
End DoDot:1
+8 QUIT
BLOOP ;
+1 KILL ABMB
+2 SET ABMDT=ABMFROM-.5
+3 SET ABMTO=ABMTO+1
+4 FOR
SET ABMDT=$ORDER(^ABMDTXST(DUZ(2),"B",ABMDT))
IF +ABMDT=0!(ABMDT>ABMTO)
QUIT
Begin DoDot:1
+5 SET ABMTIEN=0
+6 FOR
SET ABMTIEN=$ORDER(^ABMDTXST(DUZ(2),"B",ABMDT,ABMTIEN))
IF +ABMTIEN=0
QUIT
Begin DoDot:2
+7 ;EMC FILENAME
IF $PIECE($GET(^ABMDTXST(DUZ(2),ABMTIEN,1)),U,4)=""
QUIT
+8 SET ABMBDFN=0
+9 FOR
SET ABMBDFN=$ORDER(^ABMDTXST(DUZ(2),ABMTIEN,2,ABMBDFN))
IF +ABMBDFN=0
QUIT
Begin DoDot:3
+10 DO BILLCK
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
VLOOP ;
+1 KILL ABMB
+2 SET ABMDT=ABMFROM-.5
+3 SET ABMTO=ABMTO+1
+4 FOR
SET ABMDT=$ORDER(^ABMDBILL(DUZ(2),"AD",ABMDT))
IF +ABMDT=0!(ABMDT>ABMTO)
QUIT
Begin DoDot:1
+5 SET ABMBDFN=0
+6 FOR
SET ABMBDFN=$ORDER(^ABMDBILL(DUZ(2),"AD",ABMDT,ABMBDFN))
IF +ABMBDFN=0
QUIT
Begin DoDot:2
+7 DO BILLCK
End DoDot:2
End DoDot:1
+8 QUIT
BILLCK ;
+1 ;bill type
IF ($EXTRACT($PIECE($GET(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,2),1,2)'=11)
QUIT
+2 ;bill status-cancelled
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,4)="X"
QUIT
+3 ;insurer selected
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,8)'=ABMINS
QUIT
+4 ;ICD procedures
IF '$DATA(^ABMDBILL(DUZ(2),ABMBDFN,19,0))
QUIT
+5 ;export mode
SET ABMEXPM=$PIECE($GET(^ABMDBILL(DUZ(2),ABMBDFN,0)),U,6)
+6 ;837I only
IF $GET(ABMEXPM)'=21
QUIT
+7 SET ABMB(ABMEXPM,ABMBDFN)=""
+8 QUIT
OUTPUT ;
+1 ;Active Insurer IEN
SET ABMINS("IEN")=ABMINS
+2 ;Insurer type
SET ABMITYP=$PIECE(^AUTNINS(ABMINS("IEN"),2),U)
+3 ;export type
SET ABMEXP=21
+4 ; Create a new batch in 3P TX STATUS
DO NEWB
+5 IF $GET(Y)<0
DO MSG^ABMERUTL("Could not enter batch in 3P TX STATUS file.")
QUIT
+6 ; Add bill to detail in 3P TX STATUS for this batch
+7 SET ^ABMDTXST(DUZ(2),DA(1),2,0)="^9002274.61P^^"
+8 SET ABMAPOK=1
+9 SET ABMDA=0
+10 FOR
SET ABMDA=$ORDER(ABMB(21,ABMDA))
IF +ABMDA=0
QUIT
Begin DoDot:1
+11 SET X=ABMDA
+12 SET DIC="^ABMDTXST(DUZ(2),DA(1),2,"
+13 SET DIC(0)="LXNE"
+14 SET DINUM=X
+15 KILL DD,DO
DO FILE^DICN
+16 IF +Y<0
QUIT
+17 SET DA=+Y
+18 SET DIE="^ABMDTXST(DUZ(2),DA(1),2,"
+19 SET ABMAPRV=$ORDER(^ABMDBILL(DUZ(2),ABMDA,41,"C","A",0))
+20 IF ABMAPRV
SET ABMAPRV=$PIECE(^ABMDBILL(DUZ(2),ABMDA,41,ABMAPRV,0),U)
+21 IF ABMAPRV
Begin DoDot:2
+22 SET DR=".02///`"_ABMAPRV
+23 DO ^DIE
+24 KILL ABMAPRV
End DoDot:2
+25 SET ABMSBR=$$SBR^ABMUTLP(ABMDA)
+26 SET DR=".03///"_ABMSBR
+27 DO ^DIE
+28 KILL ABMSBR
End DoDot:1
+29 KILL ABMAPOK
+30 ; Write record (Create EMC unix file)
+31 DO ^ABMEF21
+32 IF $GET(POP)
Begin DoDot:1
+33 SET DIE="^ABMDTXST(DUZ(2),"
+34 SET DA=ABMP("XMIT")
+35 SET DR=".14///NOPEN"
+36 DO ^DIE
End DoDot:1
+37 QUIT
NEWB ;
+1 ; Create a new batch (Make entry in 3P TX STATUS)
+2 DO NOW^%DTC
+3 SET X=%
+4 SET DIC="^ABMDTXST(DUZ(2),"
+5 SET DIC(0)="LX"
+6 SET DLAYGO=9002274.6
+7 KILL DD,DO
DO FILE^DICN
+8 KILL DLAYGO
+9 IF Y<0
QUIT
+10 SET ABMP("XMIT")=+Y
+11 SET DIE=DIC
+12 SET DA=+Y
+13 SET DR=".02///21;.04///`"_ABMINS("IEN")_";.03///"_ABMITYP_";.05////"_DUZ
+14 DO ^DIE
+15 SET DR=".16///"_$$NSN^ABMERUTL
DO ^DIE
+16 SET DA(1)=DA
+17 WRITE !,"ENTRY CREATED IN 3P TX STATUS FILE."
+18 QUIT
CLAIM ;one claim
+1 KILL ABMP
+2 SET ABMP("INS")=ABMINS
+3 SET ABMP("ITYPE")=$PIECE($GET(^AUTNINS(ABMINS,2)),U)
+4 SET ABMP("BDFN")=ABMBDFN
+5 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
QUIT
+6 DO SET^ABMUTLP(ABMP("BDFN"))
+7 IF '$GET(ABMOSBR)
Begin DoDot:1
+8 USE 0
WRITE !,"Submission # ",ABMSUBN
+9 USE 0
WRITE !,"Writing bills to file.",!
+10 DO ^ABME8L1
+11 DO ^ABME8L2
End DoDot:1
+12 SET ABMNPDFN=$PIECE(ABMB0,U,5)
+13 IF ABMOSBR'=ABMASBR
Begin DoDot:1
+14 DO SBR
End DoDot:1
+15 IF ABMNPDFN'=ABMOPDFN
Begin DoDot:1
+16 DO PTCHG^ABME8L3
End DoDot:1
+17 SET ABMP("PNUM")=$$PNUM^ABMUTLP(ABMBILL)
+18 DO ^ABME8L5
+19 DO ^ABME8L6
+20 DO ^ABME8L7
+21 DO ^ABME8L8
+22 DO ^ABME8L10
+23 WRITE "."
+24 QUIT
SBR ;new subscriber
+1 SET ABMSFILE=$PIECE(ABMASBR,"-",1)
+2 SET ABMSIEN=$PIECE(ABMASBR,"-",2)
+3 SET ABMCHILD=0
+4 NEW I
+5 SET I=0
+6 FOR
SET I=$ORDER(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,I))
IF 'I
QUIT
Begin DoDot:1
+7 IF +^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,I)=18
QUIT
+8 SET ABMCHILD=1
End DoDot:1
+9 SET ABMP("PNUM")=$$PNUM^ABMUTLP(ABMBILL)
+10 DO ^ABME8L3
+11 SET ABMOSBR=ABMASBR
+12 SET ABMOPDFN=ABMP("PDFN")
+13 QUIT
XIT ;
+1 DO ^%ZISC
+2 WRITE !!,"Finished.",!!
+3 KILL ABMEXPM,ABMBDFN,ABMB,ABMTIEN,ABMFROM,ABMTO,ABMDT
+4 KILL ABMFILE,ABMRESUB,ABMINS
+5 QUIT
