Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMTPYMT

ABMTPYMT.m

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