ABMTPYMT ; IHS/SD/SDR - Tribal Payment Report ;
;;2.6;IHS 3P BILLING SYSTEM;**8,10,11,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR - 2.6*21 - VMBP - Updated p11 changes to include Serena ref#s
;
K ABM,ABMY
;
SEL ;
;location
D GETFACS^ABMMUMUP ;get list of facilities
S ABMCNT=0,ABMDIR="",ABMFQHC=0
F S ABMCNT=$O(ABMFLIST(ABMCNT)) Q:'ABMCNT D
.S:ABMDIR'="" ABMDIR=ABMDIR_";"_ABMCNT_":"_$$GET1^DIQ(9999999.06,$G(ABMFLIST(ABMCNT)),.01,"E")
.S:ABMDIR="" ABMDIR=ABMCNT_":"_$$GET1^DIQ(9999999.06,$G(ABMFLIST(ABMCNT)),.01,"E")
.I $D(^ABMMUPRM(1,1,"B",ABMFLIST(ABMCNT))) S ABMFQHC=1
S ABMCNT=$O(ABMFLIST(99999),-1) ;get last entry#
S (ABMCNT,ABMTOT)=ABMCNT+1
I ABMFQHC=0!(ABMCNT<2) S ABMDIR=ABMDIR_";"_ABMCNT_":All facilities"
W !!
K ABMFANS,ABMF
F D Q:+$G(Y)<0!(Y=ABMTOT)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) ;they didn't answer or ALL was selected
.D ^XBFMK
.S DIR(0)="SO^"_$G(ABMDIR)
.S:'$D(ABMF) DIR(0)="S^"_$G(ABMDIR)
.S DIR("A")="Select one or more facilities"
.D ^DIR K DIR
.Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
.S ABMFANS=Y
.I ABMFANS'=(ABMTOT) S ABMF($G(ABMFLIST(ABMFANS)))=""
.I ABMFANS=(ABMTOT) D
..S ABMCNT=0
..F S ABMCNT=$O(ABMFLIST(ABMCNT)) Q:'ABMCNT S ABMF($G(ABMFLIST(ABMCNT)))=""
K ABMFQHC
;
;insurer or insurer type?
K DIR,ABMY("ITYP"),ABMY("INS")
S DIR(0)="SO^1:INSURER;2:INSURER TYPE"
S DIR("A")="Sort by INSURER or INSURER TYPE"
D ^DIR
K DIR
Q:$D(DIRUT)!$D(DIROUT)
I Y=1 S ABMY("INS")="" D INSURER
I Y=2 S ABMY("ITYP")="" D INSTYPE
;
;tribe
K ABMY("TRIBE")
W !
F D Q:+$G(Y)<0!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
.D ^XBFMK
.S DIC="^AUTTTRI("
.S DIC(0)="QEAM"
.S DIC("A")="Select Tribe: "_$S('$D(ABMY("TRIBE")):"ALL// ",1:"")
.D ^DIC
.Q:+Y<0
.S ABMY("TRIBE")=""
.S ABMY("TRIBE",+Y)=""
;
;date range
DT ;
Q:$D(DIRUT)
S ABMY("DT")="V"
W !!," ============ Entry of Visit Date Range =============",!
S DIR("A")="Enter STARTING Visit Date for the Report"
S DIR(0)="DO^::EP"
D ^DIR
G DT:$D(DIRUT)
S ABMY("DT",1)=Y
W !
S DIR("A")="Enter ENDING DATE for the Report"
D ^DIR
K DIR
G DT:$D(DIRUT)
S ABMY("DT",2)=Y
I ABMY("DT",1)>ABMY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DT
;
K DIR
S DIR(0)="S^A:ALL bills;P:POSTED bills w/pymts and pymt credits"
S DIR("A")="All bills, or just bills with payments/payment credits posted?"
S DIR("B")="ALL"
D ^DIR
I Y="A" S ABMY("ALL")=""
I Y="P" S ABMY("POST")=""
W !
;
K DIR
S DIR(0)="SA^C:CLINIC;V:VISIT TYPE"
S DIR("A")="Sort Report by [V]isit Type or [C]linic: "
S DIR("B")="V"
S DIR("?")="Enter 'V' to sort the report by Visit Type (inpatient, outpatient, etc.) or a 'C' to sort it by the Clinic associated with each visit."
D ^DIR
I '$D(DIROUT)&('$D(DIRUT)) D
.S ABMY("SORT")=Y
.I ABMY("SORT")="C" D CLIN Q
.D VTYP
;
S ABM("HD",0)="TRIBAL PAYMENT REPORT"
S ABMQ("RC")="COMPUTE^ABMTPYMT"
S ABMQ("RX")="POUT^ABMDRUTL"
S ABMQ("NS")="ABM"
S ABMQ("RP")="PRINT^ABMTPYMT"
D ^ABMDRDBQ
Q
INSURER ;
;insurer
W !
F D Q:+$G(Y)<0!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
.D ^XBFMK
.S DIC="^AUTNINS("
.S DIC(0)="QEAM"
.S DIC("A")="Select Insurer: "_$S(($D(ABMY("INS"))<10):"ALL// ",1:"")
.D ^DIC
.Q:+Y<0
.S ABMY("INS")=""
.S ABMY("INS",+Y)=""
Q
;
INSTYPE ;
;insurer type
F D Q:+$G(Y)<0!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
.D ^XBFMK
.S DIR(0)="SO^R:MEDICARE FI;D:MEDICAID FI;P:PRIVATE;N:NON-BENEFICIARY PATIENTS;I:BENEFICIARY PATIENTS;W:WORKMAN'S COMP;K:CHIP;H:HMO;M:MEDICARE SUPPL"
.;S DIR(0)=DIR(0)_";C:CHAMPUS;F:FRATERNAL ORG;T:3P LIABILITY;G:GUARANTOR;MD:MCR PART D;MH:MEDICARE HMO;A:ALL" ;abm*2.6*11 VMBP#11 RQMT_105
.S DIR(0)=DIR(0)_";C:CHAMPUS;F:FRATERNAL ORG;T:3P LIABILITY;G:GUARANTOR;MD:MCR PART D;MH:MEDICARE HMO;V:VETERANS ADMINISTRATION;A:ALL" ;abm*2.6*11 VMBP#11 RQMT_105
.S DIR("A")="Select INSURER TYPE to Display"
.S:$D(ABMY("ITYP"))<10 DIR("B")="ALL"
.D ^DIR
.K DIR
.Q:$D(DIRUT)!$D(DIROUT)
.S ABMY("ITYP")=""
.I Y="A" S Y=-1 Q
.S ABMY("ITYP",Y)=""
Q
CLIN ;SELECT CLINICS
K ABMY("CLIN")
S DIC="^DIC(40.7,"
S DIC(0)="AEMQ"
S DIC("A")="Select Clinic: ALL// "
F D Q:+Y<0
.I $D(ABMY("CLIN")) S DIC("A")="Select Another Clinic: "
.D ^DIC
.Q:+Y<0
.S ABMY("CLIN",+Y)=""
I '$D(ABMY("CLIN")) D
.I $D(DUOUT) K ABMY("SORT") Q
.W "ALL"
K DIC
Q
;
VTYP ;SELECT VISIT TYPES
K ABMY("VTYP")
S DIC="^ABMDVTYP("
S DIC(0)="AEMQ"
S DIC("A")="Select Visit Type: ALL// "
F D Q:+Y<0
.I $D(ABMY("VTYP")) S DIC("A")="Select Another Visit Type: "
.D ^DIC
.Q:+Y<0
.S ABMY("VTYP",+Y)=""
I '$D(ABMY("VTYP")) D
.I $D(DUOUT) K ABMY("SORT") Q
.W "ALL"
K DIC
Q
;
COMPUTE ;EP - Entry Point for Setting up Data
S ABM("SUBR")="ABM-TPYMT" K ^TMP("ABM-TPYMT",$J)
S ABM("SD")=ABMY("DT",1)-.5
F S ABM("SD")=$O(^ABMDBILL(DUZ(2),"AD",ABM("SD"))) Q:'+ABM("SD")!(ABM("SD")>ABMY("DT",2)) D
.S ABM=""
.F S ABM=$O(^ABMDBILL(DUZ(2),"AD",ABM("SD"),ABM)) Q:'ABM D DATA
Q
;
DATA ;
S ABMP("HIT")=0 D BILL Q:'ABMP("HIT")
S ABM("L")=$P(^DIC(4,ABM("L"),0),U)
I $D(ABMY("ITYP")) D
.;S ABM("I")=$P($G(^AUTNINS(ABM("I"),2)),U) ;abm*2.6*10 HEAT73780
.S ABM("I")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("I"),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
.S ABM("I")=$P($T(@ABM("I")),";;",2)
I $D(ABMY("INS")) S ABM("I")=$P($G(^AUTNINS(ABM("I"),0)),U)
S ABM("TRIBE")=$P($G(^AUTTTRI(ABM("TRIBE"),0)),U)
S ABM("S")=$S(ABMY("SORT")="V":ABM("V"),1:ABM("C"))
S ^TMP("ABM-TPYMT",$J,ABM("L")_U_ABM("TRIBE")_U_ABM("S")_U_ABM("I")_U_ABM("P")_U_ABM("D")_U_ABM_U_ABM("PD"))=""
Q
H ;;HMO
M ;;MEDICARE SUPPL.
D ;;MEDICAID FI
R ;;MEDICARE FI
P ;;PRIVATE
W ;;WORKMEN'S COMP
C ;;CHAMPUS
F ;;FRATERNAL ORG
N ;;NON-BENEFICIARY
I ;;BENEFICIARY
K ;;KIDSCARE (CHIP)
T ;;THIRD PARTY LIABILITY
G ;;GUARANTOR
MD ;;MEDICARE PART D
MH ;;MEDICARE HMO
V ;;VETERANS ADMINISTRATION
;
BILL ;EP for checking Bill File data parameters
Q:'$D(^ABMDBILL(DUZ(2),ABM,0))!('$D(^(1)))
Q:$P(^ABMDBILL(DUZ(2),ABM,0),"^",4)="X"
;ABM("L") is piece 3 of bill file
S ABM("V")=$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,7)
S ABM("C")=$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,10)
Q:($D(ABMY("VTYP"))&(ABM("V")=""))
Q:($D(ABMY("CLIN"))&(ABM("C")=""))
I $D(ABMY("CLIN")),'$D(ABMY("CLIN",+$P(^ABMDBILL(DUZ(2),ABM,0),U,10))) Q
I $D(ABMY("VTYP")),'$D(ABMY("VTYP",+$P(^ABMDBILL(DUZ(2),ABM,0),U,7))) Q
S ABM("L")=$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,3)
S ABM("I")=$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,8)
S ABM("P")=$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,5)
S ABM("TRIBE")=$P($G(^AUPNPAT(ABM("P"),11)),U,8)
S ABM("D")=$P($G(^ABMDBILL(DUZ(2),ABM,7)),U)
Q:ABM("L")=""!(ABM("I")="")!(ABM("P")="")!(ABM("D")="")
Q:'$D(^AUTNINS(ABM("I"),0))
I $D(ABMY("LOC"))>10,ABMY("LOC")'=ABM("L") Q
I $D(ABMY("INS"))>10,'$D(ABMY("INS",ABM("I"))) Q
;I $D(ABMY("ITYP"))>10,'$D(ABMY("ITYP",$P($G(^AUTNINS(ABM("I"),2)),U))) Q ;abm*2.6*10 HEAT73780
I $D(ABMY("ITYP"))>10,'$D(ABMY("ITYP",$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("I"),".211","I"),1,"I"))) Q ;abm*2.6*10 HEAT73780
I $D(ABMY("TRIBE"))>10,'$D(ABMY("TRIBE",ABM("TRIBE"))) Q
K ABM("QUIT")
S ABMP("HIT")=1
S ABM("PD")=0
I +$O(^ABMDBILL(DUZ(2),ABM,3,0))=0 S:$D(ABMY("POST")) ABMP("HIT")=0 Q ;no pymts/adjs
S ABMPIEN=0
F S ABMPIEN=$O(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN)) Q:'ABMPIEN D
.;quit if no payments or payment adjustments
.I (+$P($G(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN,0)),U,10)=0)&(+$P($G(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN,0)),U,14)=0) Q
.S ABM("PD")=ABM("PD")+$P($G(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN,0)),U,10)+$P($G(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN,0)),U,14)
I +ABM("PD")=0&($D(ABMY("POST"))) S ABMP("HIT")=0 ;no pymt/pymt credit was found on bill
Q
;
PRINT ;
S ABM("PG")=1
D HDR
S ABM("TXT")="",ABM("L")="",ABM("I")="",ABM("T")="",ABM("V")=""
S ABMBILLS=0,ABMPAIDS=0
S ABMBILLT=0,ABMPAIDT=0
S ABMBILLV=0,ABMPAIDV=0
F S ABM("TXT")=$O(^TMP("ABM-TPYMT",$J,ABM("TXT"))) Q:$G(ABM("TXT"))="" D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
.I ABM("L")=""!(ABM("L")'=$P(ABM("TXT"),U)) D LOC S (ABM("T"),ABM("I"),ABM("S"))=""
.I ABM("T")'="",ABM("T")'=$P(ABM("TXT"),U,2) S (ABM("L"),ABM("I"))="" D VSUB,TSUB,TRIBE S (ABM("S"),ABM("I"))=""
.I ABM("T")="" D TRIBE
.;I ABM("S")=""!(ABM("S")'=$P(ABM("TXT"),U,3)) D VIS S (ABM("I"))=""
.I ABM("S")'="",ABM("S")'=$P(ABM("TXT"),U,3) S (ABM("I"))="" D VSUB,VIS S ABM("I")=""
.I ABM("S")="" D VIS
.I ABM("I")=""!(ABM("I")'=$P(ABM("TXT"),U,4)) D INS S (ABM("I"))=""
.S ABM("L")=$P(ABM("TXT"),U)
.S ABM("T")=$P(ABM("TXT"),U,2)
.S ABM("S")=$P(ABM("TXT"),U,3)
.S ABM("I")=$P(ABM("TXT"),U,4)
.W !,$E($$GET1^DIQ(2,$P(ABM("TXT"),U,5),".01","E"),1,26)
.W ?28,$P($G(^ABMDBILL(DUZ(2),$P(ABM("TXT"),U,7),0)),U)
.W ?37,$$SDT^ABMDUTL($P(ABM("TXT"),U,6))
.W ?48,$J($FN($P($G(^ABMDBILL(DUZ(2),$P(ABM("TXT"),U,7),2)),U),",",2),12)
.W ?62,$J($FN(+$P(ABM("TXT"),U,8),",",2),12)
.S ABMBILLS=+$G(ABMBILLS)+$P($G(^ABMDBILL(DUZ(2),$P(ABM("TXT"),U,7),2)),U)
.S ABMBILLV=+$G(ABMBILLV)+$P($G(^ABMDBILL(DUZ(2),$P(ABM("TXT"),U,7),2)),U)
.S ABMBILLT=+$G(ABMBILLT)+$P($G(^ABMDBILL(DUZ(2),$P(ABM("TXT"),U,7),2)),U)
.S ABMPAIDS=+$G(ABMPAIDS)+$P(ABM("TXT"),U,8)
.S ABMPAIDV=+$G(ABMPAIDV)+$P(ABM("TXT"),U,8)
.S ABMPAIDT=+$G(ABMPAIDT)+$P(ABM("TXT"),U,8)
D VSUB
D TSUB
W !!?48,"============",?62,"============"
W !?30,"Report Totals",?48,$J($FN(ABMBILLT,",",2),12),?62,$J($FN(ABMPAIDT,",",2),12)
K ^TMP("ABM-TPYMT",$J)
Q
;
HD ;
D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("PG")=+$G(ABM("PG"))+1
HDR ;
D EN^ABMVDF("IOF")
W !
S ABM("HD",0)="TRIBAL PAYMENT REPORT"
D NOW^%DTC ;abm*2.6*1 NO HEAT
W ABM("HD",0),?$S($D(ABM(132)):103,1:48) S Y=% X ^DD("DD") W Y," Page ",ABM("PG") ;abm*2.6*1 NO HEAT ;abm*2.6*3 HEAT12210
W !,"for Visit Dates from ",$$SDT^ABMDUTL(ABMY("DT",1))," to ",$$SDT^ABMDUTL(ABMY("DT",2))
W !,"Billing Location: ",$P($G(^AUTTLOC(DUZ(2),0)),U,2)
W !
F ABM=1:1:80 W "="
W !,"PATIENT",?28,"CLAIM",?37,"DOS",?48,"AMOUNT BILLED",?62,"AMOUNT PAID",!
F ABM=1:1:80 W "="
W !
Q
LOC ;
W !,"Location: ",$P(ABM("TXT"),U)
Q
VIS ;
W !
I ABMY("SORT")="C" W ?5,"Clinic: ",$P(^DIC(40.7,$P(ABM("TXT"),U,3),0),U)
I ABMY("SORT")="V" W ?5,"Visit Type: ",$P(^ABMDVTYP($P(ABM("TXT"),U,3),0),U)
Q
VSUB ;
W !?48,"============",?62,"============"
W !?30
I ABMY("SORT")="C" W ?5,"Clinic"
I ABMY("SORT")="V" W ?5,"Visit Type"
W " Totals",?48,$J($FN(ABMBILLV,",",2),12),?62,$J($FN(ABMPAIDV,",",2),12)
S ABMBILLV=0,ABMPAIDV=0
Q
INS ;
I $D(ABMY("INS")) W !?7,"Insurer: "
I $D(ABMY("ITYP")) W !?7,"Insurer Type: "
W $P(ABM("TXT"),U,4)
Q
TRIBE ;
W !!?3,"Tribe: ",$P(ABM("TXT"),U,2)
Q
TSUB ;
W !?48,"============",?62,"============"
W !?30,"Tribe Totals",?48,$J($FN(ABMBILLS,",",2),12),?62,$J($FN(ABMPAIDS,",",2),12)
S ABMBILLS=0,ABMPAIDS=0
Q
ABMTPYMT ; IHS/SD/SDR - Tribal Payment Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**8,10,11,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR - 2.6*21 - VMBP - Updated p11 changes to include Serena ref#s
+3 ;
+4 KILL ABM,ABMY
+5 ;
SEL ;
+1 ;location
+2 ;get list of facilities
DO GETFACS^ABMMUMUP
+3 SET ABMCNT=0
SET ABMDIR=""
SET ABMFQHC=0
+4 FOR
SET ABMCNT=$ORDER(ABMFLIST(ABMCNT))
IF 'ABMCNT
QUIT
Begin DoDot:1
+5 IF ABMDIR'=""
SET ABMDIR=ABMDIR_";"_ABMCNT_":"_$$GET1^DIQ(9999999.06,$GET(ABMFLIST(ABMCNT)),.01,"E")
+6 IF ABMDIR=""
SET ABMDIR=ABMCNT_":"_$$GET1^DIQ(9999999.06,$GET(ABMFLIST(ABMCNT)),.01,"E")
+7 IF $DATA(^ABMMUPRM(1,1,"B",ABMFLIST(ABMCNT)))
SET ABMFQHC=1
End DoDot:1
+8 ;get last entry#
SET ABMCNT=$ORDER(ABMFLIST(99999),-1)
+9 SET (ABMCNT,ABMTOT)=ABMCNT+1
+10 IF ABMFQHC=0!(ABMCNT<2)
SET ABMDIR=ABMDIR_";"_ABMCNT_":All facilities"
+11 WRITE !!
+12 KILL ABMFANS,ABMF
+13 ;they didn't answer or ALL was selected
FOR
Begin DoDot:1
+14 DO ^XBFMK
+15 SET DIR(0)="SO^"_$GET(ABMDIR)
+16 IF '$DATA(ABMF)
SET DIR(0)="S^"_$GET(ABMDIR)
+17 SET DIR("A")="Select one or more facilities"
+18 DO ^DIR
KILL DIR
+19 IF $DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIRUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIROUT)
QUIT
+20 SET ABMFANS=Y
+21 IF ABMFANS'=(ABMTOT)
SET ABMF($GET(ABMFLIST(ABMFANS)))=""
+22 IF ABMFANS=(ABMTOT)
Begin DoDot:2
+23 SET ABMCNT=0
+24 FOR
SET ABMCNT=$ORDER(ABMFLIST(ABMCNT))
IF 'ABMCNT
QUIT
SET ABMF($GET(ABMFLIST(ABMCNT)))=""
End DoDot:2
End DoDot:1
IF +$GET(Y)<0!(Y=ABMTOT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIRUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIROUT)
QUIT
+25 KILL ABMFQHC
+26 ;
+27 ;insurer or insurer type?
+28 KILL DIR,ABMY("ITYP"),ABMY("INS")
+29 SET DIR(0)="SO^1:INSURER;2:INSURER TYPE"
+30 SET DIR("A")="Sort by INSURER or INSURER TYPE"
+31 DO ^DIR
+32 KILL DIR
+33 IF $DATA">DATA(DIRUT)!$DATA">DATA(DIROUT)
QUIT
+34 IF Y=1
SET ABMY("INS")=""
DO INSURER
+35 IF Y=2
SET ABMY("ITYP")=""
DO INSTYPE
+36 ;
+37 ;tribe
+38 KILL ABMY("TRIBE")
+39 WRITE !
+40 FOR
Begin DoDot:1
+41 DO ^XBFMK
+42 SET DIC="^AUTTTRI("
+43 SET DIC(0)="QEAM"
+44 SET DIC("A")="Select Tribe: "_$SELECT('$DATA(ABMY("TRIBE")):"ALL// ",1:"")
+45 DO ^DIC
+46 IF +Y<0
QUIT
+47 SET ABMY("TRIBE")=""
+48 SET ABMY("TRIBE",+Y)=""
End DoDot:1
IF +$GET(Y)<0!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIRUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIROUT)
QUIT
+49 ;
+50 ;date range
DT ;
+1 IF $DATA(DIRUT)
QUIT
+2 SET ABMY("DT")="V"
+3 WRITE !!," ============ Entry of Visit Date Range =============",!
+4 SET DIR("A")="Enter STARTING Visit Date for the Report"
+5 SET DIR(0)="DO^::EP"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
GOTO DT
+8 SET ABMY("DT",1)=Y
+9 WRITE !
+10 SET DIR("A")="Enter ENDING DATE for the Report"
+11 DO ^DIR
+12 KILL DIR
+13 IF $DATA(DIRUT)
GOTO DT
+14 SET ABMY("DT",2)=Y
+15 IF ABMY("DT",1)>ABMY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
GOTO DT
+16 ;
+17 KILL DIR
+18 SET DIR(0)="S^A:ALL bills;P:POSTED bills w/pymts and pymt credits"
+19 SET DIR("A")="All bills, or just bills with payments/payment credits posted?"
+20 SET DIR("B")="ALL"
+21 DO ^DIR
+22 IF Y="A"
SET ABMY("ALL")=""
+23 IF Y="P"
SET ABMY("POST")=""
+24 WRITE !
+25 ;
+26 KILL DIR
+27 SET DIR(0)="SA^C:CLINIC;V:VISIT TYPE"
+28 SET DIR("A")="Sort Report by [V]isit Type or [C]linic: "
+29 SET DIR("B")="V"
+30 SET DIR("?")="Enter 'V' to sort the report by Visit Type (inpatient, outpatient, etc.) or a 'C' to sort it by the Clinic associated with each visit."
+31 DO ^DIR
+32 IF '$DATA">DATA(DIROUT)&('$DATA">DATA(DIRUT))
Begin DoDot:1
+33 SET ABMY("SORT")=Y
+34 IF ABMY("SORT")="C"
DO CLIN
QUIT
+35 DO VTYP
End DoDot:1
+36 ;
+37 SET ABM("HD",0)="TRIBAL PAYMENT REPORT"
+38 SET ABMQ("RC")="COMPUTE^ABMTPYMT"
+39 SET ABMQ("RX")="POUT^ABMDRUTL"
+40 SET ABMQ("NS")="ABM"
+41 SET ABMQ("RP")="PRINT^ABMTPYMT"
+42 DO ^ABMDRDBQ
+43 QUIT
INSURER ;
+1 ;insurer
+2 WRITE !
+3 FOR
Begin DoDot:1
+4 DO ^XBFMK
+5 SET DIC="^AUTNINS("
+6 SET DIC(0)="QEAM"
+7 SET DIC("A")="Select Insurer: "_$SELECT(($DATA(ABMY("INS"))<10):"ALL// ",1:"")
+8 DO ^DIC
+9 IF +Y<0
QUIT
+10 SET ABMY("INS")=""
+11 SET ABMY("INS",+Y)=""
End DoDot:1
IF +$GET(Y)<0!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIRUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIROUT)
QUIT
+12 QUIT
+13 ;
INSTYPE ;
+1 ;insurer type
+2 FOR
Begin DoDot:1
+3 DO ^XBFMK
+4 SET DIR(0)="SO^R:MEDICARE FI;D:MEDICAID FI;P:PRIVATE;N:NON-BENEFICIARY PATIENTS;I:BENEFICIARY PATIENTS;W:WORKMAN'S COMP;K:CHIP;H:HMO;M:MEDICARE SUPPL"
+5 ;S DIR(0)=DIR(0)_";C:CHAMPUS;F:FRATERNAL ORG;T:3P LIABILITY;G:GUARANTOR;MD:MCR PART D;MH:MEDICARE HMO;A:ALL" ;abm*2.6*11 VMBP#11 RQMT_105
+6 ;abm*2.6*11 VMBP#11 RQMT_105
SET DIR(0)=DIR(0)_";C:CHAMPUS;F:FRATERNAL ORG;T:3P LIABILITY;G:GUARANTOR;MD:MCR PART D;MH:MEDICARE HMO;V:VETERANS ADMINISTRATION;A:ALL"
+7 SET DIR("A")="Select INSURER TYPE to Display"
+8 IF $DATA(ABMY("ITYP"))<10
SET DIR("B")="ALL"
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA">DATA(DIRUT)!$DATA">DATA(DIROUT)
QUIT
+12 SET ABMY("ITYP")=""
+13 IF Y="A"
SET Y=-1
QUIT
+14 SET ABMY("ITYP",Y)=""
End DoDot:1
IF +$GET(Y)<0!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIRUT)!$DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIROUT)
QUIT
+15 QUIT
CLIN ;SELECT CLINICS
+1 KILL ABMY("CLIN")
+2 SET DIC="^DIC(40.7,"
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select Clinic: ALL// "
+5 FOR
Begin DoDot:1
+6 IF $DATA(ABMY("CLIN"))
SET DIC("A")="Select Another Clinic: "
+7 DO ^DIC
+8 IF +Y<0
QUIT
+9 SET ABMY("CLIN",+Y)=""
End DoDot:1
IF +Y<0
QUIT
+10 IF '$DATA(ABMY("CLIN"))
Begin DoDot:1
+11 IF $DATA(DUOUT)
KILL ABMY("SORT")
QUIT
+12 WRITE "ALL"
End DoDot:1
+13 KILL DIC
+14 QUIT
+15 ;
VTYP ;SELECT VISIT TYPES
+1 KILL ABMY("VTYP")
+2 SET DIC="^ABMDVTYP("
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select Visit Type: ALL// "
+5 FOR
Begin DoDot:1
+6 IF $DATA(ABMY("VTYP"))
SET DIC("A")="Select Another Visit Type: "
+7 DO ^DIC
+8 IF +Y<0
QUIT
+9 SET ABMY("VTYP",+Y)=""
End DoDot:1
IF +Y<0
QUIT
+10 IF '$DATA(ABMY("VTYP"))
Begin DoDot:1
+11 IF $DATA(DUOUT)
KILL ABMY("SORT")
QUIT
+12 WRITE "ALL"
End DoDot:1
+13 KILL DIC
+14 QUIT
+15 ;
COMPUTE ;EP - Entry Point for Setting up Data
+1 SET ABM("SUBR")="ABM-TPYMT"
KILL ^TMP("ABM-TPYMT",$JOB)
+2 SET ABM("SD")=ABMY("DT",1)-.5
+3 FOR
SET ABM("SD")=$ORDER(^ABMDBILL(DUZ(2),"AD",ABM("SD")))
IF '+ABM("SD")!(ABM("SD")>ABMY("DT",2))
QUIT
Begin DoDot:1
+4 SET ABM=""
+5 FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AD",ABM("SD"),ABM))
IF 'ABM
QUIT
DO DATA
End DoDot:1
+6 QUIT
+7 ;
DATA ;
+1 SET ABMP("HIT")=0
DO BILL
IF 'ABMP("HIT")
QUIT
+2 SET ABM("L")=$PIECE(^DIC(4,ABM("L"),0),U)
+3 IF $DATA(ABMY("ITYP"))
Begin DoDot:1
+4 ;S ABM("I")=$P($G(^AUTNINS(ABM("I"),2)),U) ;abm*2.6*10 HEAT73780
+5 ;abm*2.6*10 HEAT73780
SET ABM("I")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("I"),".211","I"),1,"I")
+6 SET ABM("I")=$PIECE($TEXT(@ABM("I")),";;",2)
End DoDot:1
+7 IF $DATA(ABMY("INS"))
SET ABM("I")=$PIECE($GET(^AUTNINS(ABM("I"),0)),U)
+8 SET ABM("TRIBE")=$PIECE($GET(^AUTTTRI(ABM("TRIBE"),0)),U)
+9 SET ABM("S")=$SELECT(ABMY("SORT")="V":ABM("V"),1:ABM("C"))
+10 SET ^TMP("ABM-TPYMT",$JOB,ABM("L")_U_ABM("TRIBE")_U_ABM("S")_U_ABM("I")_U_ABM("P")_U_ABM("D")_U_ABM_U_ABM("PD"))=""
+11 QUIT
H ;;HMO
M ;;MEDICARE SUPPL.
D ;;MEDICAID FI
R ;;MEDICARE FI
P ;;PRIVATE
W ;;WORKMEN'S COMP
C ;;CHAMPUS
F ;;FRATERNAL ORG
N ;;NON-BENEFICIARY
I ;;BENEFICIARY
K ;;KIDSCARE (CHIP)
T ;;THIRD PARTY LIABILITY
G ;;GUARANTOR
MD ;;MEDICARE PART D
MH ;;MEDICARE HMO
V ;;VETERANS ADMINISTRATION
+1 ;
BILL ;EP for checking Bill File data parameters
+1 IF '$DATA">DATA(^ABMDBILL(DUZ(2),ABM,0))!('$DATA">DATA(^(1)))
QUIT
+2 IF $PIECE(^ABMDBILL(DUZ(2),ABM,0),"^",4)="X"
QUIT
+3 ;ABM("L") is piece 3 of bill file
+4 SET ABM("V")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,7)
+5 SET ABM("C")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,10)
+6 IF ($DATA(ABMY("VTYP"))&(ABM("V")=""))
QUIT
+7 IF ($DATA(ABMY("CLIN"))&(ABM("C")=""))
QUIT
+8 IF $DATA(ABMY("CLIN"))
IF '$DATA(ABMY("CLIN",+$PIECE(^ABMDBILL(DUZ(2),ABM,0),U,10)))
QUIT
+9 IF $DATA(ABMY("VTYP"))
IF '$DATA(ABMY("VTYP",+$PIECE(^ABMDBILL(DUZ(2),ABM,0),U,7)))
QUIT
+10 SET ABM("L")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,3)
+11 SET ABM("I")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,8)
+12 SET ABM("P")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,5)
+13 SET ABM("TRIBE")=$PIECE($GET(^AUPNPAT(ABM("P"),11)),U,8)
+14 SET ABM("D")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,7)),U)
+15 IF ABM("L")=""!(ABM("I")="")!(ABM("P")="")!(ABM("D")="")
QUIT
+16 IF '$DATA(^AUTNINS(ABM("I"),0))
QUIT
+17 IF $DATA(ABMY("LOC"))>10
IF ABMY("LOC")'=ABM("L")
QUIT
+18 IF $DATA(ABMY("INS"))>10
IF '$DATA(ABMY("INS",ABM("I")))
QUIT
+19 ;I $D(ABMY("ITYP"))>10,'$D(ABMY("ITYP",$P($G(^AUTNINS(ABM("I"),2)),U))) Q ;abm*2.6*10 HEAT73780
+20 ;abm*2.6*10 HEAT73780
IF $DATA(ABMY("ITYP"))>10
IF '$DATA(ABMY("ITYP",$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("I"),".211","I"),1,"I")))
QUIT
+21 IF $DATA(ABMY("TRIBE"))>10
IF '$DATA(ABMY("TRIBE",ABM("TRIBE")))
QUIT
+22 KILL ABM("QUIT")
+23 SET ABMP("HIT")=1
+24 SET ABM("PD")=0
+25 ;no pymts/adjs
IF +$ORDER(^ABMDBILL(DUZ(2),ABM,3,0))=0
IF $DATA(ABMY("POST"))
SET ABMP("HIT")=0
QUIT
+26 SET ABMPIEN=0
+27 FOR
SET ABMPIEN=$ORDER(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:1
+28 ;quit if no payments or payment adjustments
+29 IF (+$PIECE($GET(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN,0)),U,10)=0)&(+$PIECE($GET(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN,0)),U,14)=0)
QUIT
+30 SET ABM("PD")=ABM("PD")+$PIECE($GET(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN,0)),U,10)+$PIECE($GET(^ABMDBILL(DUZ(2),ABM,3,ABMPIEN,0)),U,14)
End DoDot:1
+31 ;no pymt/pymt credit was found on bill
IF +ABM("PD")=0&($DATA(ABMY("POST")))
SET ABMP("HIT")=0
+32 QUIT
+33 ;
PRINT ;
+1 SET ABM("PG")=1
+2 DO HDR
+3 SET ABM("TXT")=""
SET ABM("L")=""
SET ABM("I")=""
SET ABM("T")=""
SET ABM("V")=""
+4 SET ABMBILLS=0
SET ABMPAIDS=0
+5 SET ABMBILLT=0
SET ABMPAIDT=0
+6 SET ABMBILLV=0
SET ABMPAIDV=0
+7 FOR
SET ABM("TXT")=$ORDER(^TMP("ABM-TPYMT",$JOB,ABM("TXT")))
IF $GET(ABM("TXT"))=""
QUIT
Begin DoDot:1
+8 IF $Y>(IOSL-5)
DO HD
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
WRITE " (cont)"
+9 IF ABM("L")=""!(ABM("L")'=$PIECE(ABM("TXT"),U))
DO LOC
SET (ABM("T"),ABM("I"),ABM("S"))=""
+10 IF ABM("T")'=""
IF ABM("T")'=$PIECE(ABM("TXT"),U,2)
SET (ABM("L"),ABM("I"))=""
DO VSUB
DO TSUB
DO TRIBE
SET (ABM("S"),ABM("I"))=""
+11 IF ABM("T")=""
DO TRIBE
+12 ;I ABM("S")=""!(ABM("S")'=$P(ABM("TXT"),U,3)) D VIS S (ABM("I"))=""
+13 IF ABM("S")'=""
IF ABM("S")'=$PIECE(ABM("TXT"),U,3)
SET (ABM("I"))=""
DO VSUB
DO VIS
SET ABM("I")=""
+14 IF ABM("S")=""
DO VIS
+15 IF ABM("I")=""!(ABM("I")'=$PIECE(ABM("TXT"),U,4))
DO INS
SET (ABM("I"))=""
+16 SET ABM("L")=$PIECE(ABM("TXT"),U)
+17 SET ABM("T")=$PIECE(ABM("TXT"),U,2)
+18 SET ABM("S")=$PIECE(ABM("TXT"),U,3)
+19 SET ABM("I")=$PIECE(ABM("TXT"),U,4)
+20 WRITE !,$EXTRACT($$GET1^DIQ(2,$PIECE(ABM("TXT"),U,5),".01","E"),1,26)
+21 WRITE ?28,$PIECE($GET(^ABMDBILL(DUZ(2),$PIECE(ABM("TXT"),U,7),0)),U)
+22 WRITE ?37,$$SDT^ABMDUTL($PIECE(ABM("TXT"),U,6))
+23 WRITE ?48,$JUSTIFY($FNUMBER($PIECE($GET(^ABMDBILL(DUZ(2),$PIECE(ABM("TXT"),U,7),2)),U),",",2),12)
+24 WRITE ?62,$JUSTIFY($FNUMBER(+$PIECE(ABM("TXT"),U,8),",",2),12)
+25 SET ABMBILLS=+$GET(ABMBILLS)+$PIECE($GET(^ABMDBILL(DUZ(2),$PIECE(ABM("TXT"),U,7),2)),U)
+26 SET ABMBILLV=+$GET(ABMBILLV)+$PIECE($GET(^ABMDBILL(DUZ(2),$PIECE(ABM("TXT"),U,7),2)),U)
+27 SET ABMBILLT=+$GET(ABMBILLT)+$PIECE($GET(^ABMDBILL(DUZ(2),$PIECE(ABM("TXT"),U,7),2)),U)
+28 SET ABMPAIDS=+$GET(ABMPAIDS)+$PIECE(ABM("TXT"),U,8)
+29 SET ABMPAIDV=+$GET(ABMPAIDV)+$PIECE(ABM("TXT"),U,8)
+30 SET ABMPAIDT=+$GET(ABMPAIDT)+$PIECE(ABM("TXT"),U,8)
End DoDot:1
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+31 DO VSUB
+32 DO TSUB
+33 WRITE !!?48,"============",?62,"============"
+34 WRITE !?30,"Report Totals",?48,$JUSTIFY($FNUMBER(ABMBILLT,",",2),12),?62,$JUSTIFY($FNUMBER(ABMPAIDT,",",2),12)
+35 KILL ^TMP("ABM-TPYMT",$JOB)
+36 QUIT
+37 ;
HD ;
+1 DO PAZ^ABMDRUTL
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+2 SET ABM("PG")=+$GET(ABM("PG"))+1
HDR ;
+1 DO EN^ABMVDF("IOF")
+2 WRITE !
+3 SET ABM("HD",0)="TRIBAL PAYMENT REPORT"
+4 ;abm*2.6*1 NO HEAT
DO NOW^%DTC
+5 ;abm*2.6*1 NO HEAT ;abm*2.6*3 HEAT12210
WRITE ABM("HD",0),?$SELECT($DATA(ABM(132)):103,1:48)
SET Y=%
XECUTE ^DD("DD")
WRITE Y," Page ",ABM("PG")
+6 WRITE !,"for Visit Dates from ",$$SDT^ABMDUTL(ABMY("DT",1))," to ",$$SDT^ABMDUTL(ABMY("DT",2))
+7 WRITE !,"Billing Location: ",$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)
+8 WRITE !
+9 FOR ABM=1:1:80
WRITE "="
+10 WRITE !,"PATIENT",?28,"CLAIM",?37,"DOS",?48,"AMOUNT BILLED",?62,"AMOUNT PAID",!
+11 FOR ABM=1:1:80
WRITE "="
+12 WRITE !
+13 QUIT
LOC ;
+1 WRITE !,"Location: ",$PIECE(ABM("TXT"),U)
+2 QUIT
VIS ;
+1 WRITE !
+2 IF ABMY("SORT")="C"
WRITE ?5,"Clinic: ",$PIECE(^DIC(40.7,$PIECE(ABM("TXT"),U,3),0),U)
+3 IF ABMY("SORT")="V"
WRITE ?5,"Visit Type: ",$PIECE(^ABMDVTYP($PIECE(ABM("TXT"),U,3),0),U)
+4 QUIT
VSUB ;
+1 WRITE !?48,"============",?62,"============"
+2 WRITE !?30
+3 IF ABMY("SORT")="C"
WRITE ?5,"Clinic"
+4 IF ABMY("SORT")="V"
WRITE ?5,"Visit Type"
+5 WRITE " Totals",?48,$JUSTIFY($FNUMBER(ABMBILLV,",",2),12),?62,$JUSTIFY($FNUMBER(ABMPAIDV,",",2),12)
+6 SET ABMBILLV=0
SET ABMPAIDV=0
+7 QUIT
INS ;
+1 IF $DATA(ABMY("INS"))
WRITE !?7,"Insurer: "
+2 IF $DATA(ABMY("ITYP"))
WRITE !?7,"Insurer Type: "
+3 WRITE $PIECE(ABM("TXT"),U,4)
+4 QUIT
TRIBE ;
+1 WRITE !!?3,"Tribe: ",$PIECE(ABM("TXT"),U,2)
+2 QUIT
TSUB ;
+1 WRITE !?48,"============",?62,"============"
+2 WRITE !?30,"Tribe Totals",?48,$JUSTIFY($FNUMBER(ABMBILLS,",",2),12),?62,$JUSTIFY($FNUMBER(ABMPAIDS,",",2),12)
+3 SET ABMBILLS=0
SET ABMPAIDS=0
+4 QUIT