ABMDRAPP ; IHS/ASDST/DMJ - DISPLAY APPROVED BILLS ;
;;2.6;IHS 3P BILLING SYSTEM;**8**;NOV 12, 2009
;Original;TMD;07/11/95 3:42 PM
;
; IHS/DSD/LSL - 05/21/98 - NOIS QDD-0598-130116
; Not doing dates right
;
; IHS/ASDS/SDH - 03/08/01 - V2.4 Patch 9 - NOIS XJG-0201-160063
; Modified to allow the exclusion parameter of Provider to work
; properly.
;
; *********************************************************************
;
K ABM,ABMY,DIR
S DIR(0)="SO^1:Summarized Report by EXPORT MODE;2:Summarized Report by INSURER;3:Listing of UNPRINTED BILLS"
S DIR("A")="Select the desired REPORT TYPE"
S DIR("B")=1
D ^DIR
Q:$D(DIRUT)!$D(DIROUT)
S ABMP("VAR")=Y
S ABM("NODX")=""
S:$D(DUZ) ABM("APPR")=DUZ
D ^ABMDRSEL
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("HD",0)="BILLS AWAITING EXPORT"
D ^ABMDRHD
S ABMQ("RX")="POUT^ABMDRUTL"
S ABMQ("NS")="ABM"
I ABMP("VAR")>2 S ABMQ("RC")="COMPUTE^ABMDRAPP",ABMQ("RP")="PRINT^ABMDRAPP"
E S ABMQ("RC")="COMPUTE^ABMDRAP1",ABMQ("RP")="PRINT^ABMDRAP1"
D ^ABMDRDBQ
Q
;
COMPUTE ;EP - Entry Point for Setting up Data
Q
;
PRINT ;EP for printing data
U IO
S ABM("PG")=0
D HDB
S ABMP("BDFN")="",U="^"
F S ABMP("BDFN")=$O(^ABMDBILL(DUZ(2),"AC","A",ABMP("BDFN"))) Q:'ABMP("BDFN") D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
. Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
. Q:"RA"'[$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4)
. I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
. I $D(ABMY("LOC")),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,3)'=ABMY("LOC") Q
. I $D(ABMY("PRV")),'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"B",ABMY("PRV"))) Q
. I $D(ABMY("DX")),'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABMY("DX"))) Q
. I $D(ABMY("TYP")),ABMY("TYP")'[$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,2) Q
. I $D(ABMY("INS")),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8)'=ABMY("INS") Q
. I $D(ABMY("APPR")),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,4)'=ABMY("APPR") Q
. I $G(ABMY("DT"))="A",$P($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,5),".")<ABMY("DT",1)!($P($P(^(1),U,5),".")>ABMY("DT",2)) Q
. I $D(ABMY("DT"))="V",$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,7)=111,$P($P(^(6),U),".")<ABMY("DT",1)!($P($P(^(6),U),".")>ABMY("DT",2)) Q
. I $D(ABMY("DT"))="V",$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,7)'=111,$P($P(^(7),U),".")<ABMY("DT",1)!($P($P(^(7),U),".")>ABMY("DT",2)) Q
. I $D(ABMY("DT"))="X",$P($P(^ABMDTXST(DUZ(2),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0),U),".")<ABMY("DT",1)!($P($P(^(0),U),".")>ABMY("DT",2)) Q
. W !,$J("",8-$L($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U))\2)_$P(^(0),U),?10,$E($P(^DPT($P(^(0),U,5),0),U),1,29)
. W ?41,$P(^ABMDEXP($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6),0),U)
.; W ?53,$E($P(^AUTNINS($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8),0),U),1,27) ;abm*2.6*8 NOHEAT
. W:+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)'=0 ?53,$E($P(^AUTNINS($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8),0),U),1,27) ;abm*2.6*8 NOHEAT
. Q
;
XIT ;
D POUT^ABMDRUTL
Q
;
HD ;
D PAZ^ABMDRUTL
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
;
HDB ;
S ABM("PG")=ABM("PG")+1
S ABM("I")=""
D WHD^ABMDRHD
W !," Bill",?42,"Export"
W !," Number",?17,"Patient",?43,"Mode",?58,"Billing Source"
W !,"-------------------------------------------------------------------------------"
Q
ABMDRAPP ; IHS/ASDST/DMJ - DISPLAY APPROVED BILLS ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**8**;NOV 12, 2009
+2 ;Original;TMD;07/11/95 3:42 PM
+3 ;
+4 ; IHS/DSD/LSL - 05/21/98 - NOIS QDD-0598-130116
+5 ; Not doing dates right
+6 ;
+7 ; IHS/ASDS/SDH - 03/08/01 - V2.4 Patch 9 - NOIS XJG-0201-160063
+8 ; Modified to allow the exclusion parameter of Provider to work
+9 ; properly.
+10 ;
+11 ; *********************************************************************
+12 ;
+13 KILL ABM,ABMY,DIR
+14 SET DIR(0)="SO^1:Summarized Report by EXPORT MODE;2:Summarized Report by INSURER;3:Listing of UNPRINTED BILLS"
+15 SET DIR("A")="Select the desired REPORT TYPE"
+16 SET DIR("B")=1
+17 DO ^DIR
+18 IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+19 SET ABMP("VAR")=Y
+20 SET ABM("NODX")=""
+21 IF $DATA(DUZ)
SET ABM("APPR")=DUZ
+22 DO ^ABMDRSEL
+23 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+24 SET ABM("HD",0)="BILLS AWAITING EXPORT"
+25 DO ^ABMDRHD
+26 SET ABMQ("RX")="POUT^ABMDRUTL"
+27 SET ABMQ("NS")="ABM"
+28 IF ABMP("VAR")>2
SET ABMQ("RC")="COMPUTE^ABMDRAPP"
SET ABMQ("RP")="PRINT^ABMDRAPP"
+29 IF '$TEST
SET ABMQ("RC")="COMPUTE^ABMDRAP1"
SET ABMQ("RP")="PRINT^ABMDRAP1"
+30 DO ^ABMDRDBQ
+31 QUIT
+32 ;
COMPUTE ;EP - Entry Point for Setting up Data
+1 QUIT
+2 ;
PRINT ;EP for printing data
+1 USE IO
+2 SET ABM("PG")=0
+3 DO HDB
+4 SET ABMP("BDFN")=""
SET U="^"
+5 FOR
SET ABMP("BDFN")=$ORDER(^ABMDBILL(DUZ(2),"AC","A",ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:1
+6 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
QUIT
+7 IF "RA"'[$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4)
QUIT
+8 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+9 IF $DATA(ABMY("LOC"))
IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,3)'=ABMY("LOC")
QUIT
+10 IF $DATA(ABMY("PRV"))
IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"B",ABMY("PRV")))
QUIT
+11 IF $DATA(ABMY("DX"))
IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABMY("DX")))
QUIT
+12 IF $DATA(ABMY("TYP"))
IF ABMY("TYP")'[$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,2)
QUIT
+13 IF $DATA(ABMY("INS"))
IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8)'=ABMY("INS")
QUIT
+14 IF $DATA(ABMY("APPR"))
IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,4)'=ABMY("APPR")
QUIT
+15 IF $GET(ABMY("DT"))="A"
IF $PIECE($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,5),".")<ABMY("DT",1)!($PIECE($PIECE(^(1),U,5),".")>ABMY("DT",2))
QUIT
+16 IF $DATA(ABMY("DT"))="V"
IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,7)=111
IF $PIECE($PIECE(^(6),U),".")<ABMY("DT",1)!($PIECE($PIECE(^(6),U),".")>ABMY("DT",2))
QUIT
+17 IF $DATA(ABMY("DT"))="V"
IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,7)'=111
IF $PIECE($PIECE(^(7),U),".")<ABMY("DT",1)!($PIECE($PIECE(^(7),U),".")>ABMY("DT",2))
QUIT
+18 IF $DATA(ABMY("DT"))="X"
IF $PIECE($PIECE(^ABMDTXST(DUZ(2),$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0),U),".")<ABMY("DT",1)!($PIECE($PIECE(^(0),U),".")>ABMY("DT",2))
QUIT
+19 WRITE !,$JUSTIFY("",8-$LENGTH($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U))\2)_$PIECE(^(0),U),?10,$EXTRACT($PIECE(^DPT($PIECE(^(0),U,5),0),U),1,29)
+20 WRITE ?41,$PIECE(^ABMDEXP($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6),0),U)
+21 ; W ?53,$E($P(^AUTNINS($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8),0),U),1,27) ;abm*2.6*8 NOHEAT
+22 ;abm*2.6*8 NOHEAT
IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,8)'=0
WRITE ?53,$EXTRACT($PIECE(^AUTNINS($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8),0),U),1,27)
+23 QUIT
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+24 ;
XIT ;
+1 DO POUT^ABMDRUTL
+2 QUIT
+3 ;
HD ;
+1 DO PAZ^ABMDRUTL
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+3 ;
HDB ;
+1 SET ABM("PG")=ABM("PG")+1
+2 SET ABM("I")=""
+3 DO WHD^ABMDRHD
+4 WRITE !," Bill",?42,"Export"
+5 WRITE !," Number",?17,"Patient",?43,"Mode",?58,"Billing Source"
+6 WRITE !,"-------------------------------------------------------------------------------"
+7 QUIT
