- 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
