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

ABMUBLST.m

Go to the documentation of this file.
  1. ABMUBLST ; IHS/SD/SDR - 3PB/UFMS Bills not export report
  1. ;;2.6;IHS 3P BILLING SYSTEM;**4,10,21**;NOV 12, 2009;Build 379
  1. ; New routine - v2.6 p4
  1. ;IHS/SD/SDR - 2.6*21 - HEAT169752 - Added code so user can decide if they want to exclude I and T insurer types from report
  1. ;
  1. DT ;
  1. W !!," ============ Entry of APPROVAL DATE Range =============",!
  1. S DIR("A")="Enter STARTING APPROVAL DATE for the Report"
  1. S DIR(0)="DO^::EP"
  1. S DIR("B")="10/01/2008"
  1. D ^DIR
  1. Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1. S ABMY("DT",1)=Y
  1. W !
  1. S DIR("A")="Enter ENDING DATE for the Report"
  1. S DIR("B")="TODAY"
  1. D ^DIR
  1. K DIR
  1. Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  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. I ABMY("DT",1)<3081001 W !!,*7,"INPUT ERROR: Start Date must be on or before 10/01/2008, TRY AGAIN!",!! G DT
  1. ;start new abm*2.6*21 IHS/SD/SDR HEAT169752
  1. EXCLUDE ;EP
  1. W !
  1. S DIR("A",2)="Insurer Types I (Indian Patient) and T (3P Liability) don't go to UFMS"
  1. S DIR("A")="Exclude these Insurer Types from report as well"
  1. S DIR(0)="Y"
  1. S DIR("B")="YES"
  1. D ^DIR
  1. Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1. I Y=1 S ABMY("ITYPEXC")=1
  1. K DIR
  1. W !
  1. ;end new abm*2.6*21 IHS/SD/SDR HEAT169752
  1. SEL ;
  1. ; Select device
  1. S DIR(0)="F"
  1. S DIR("A")="Enter Path"
  1. S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1. S ABMPATH=Y
  1. S DIR(0)="F",DIR("A")="Enter File Name"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1. S ABMFN=Y
  1. PRINT ;EP
  1. ; Callable point for queuing
  1. S ABME("PG")=0
  1. D GETDATA
  1. D WRITE Q:(IOST["C")&(($G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
  1. W !!,$$EN^ABMVDF("HIN"),"E N D O F R E P O R T",$$EN^ABMVDF("HIF"),!
  1. I $E(IOST)="C" S DIR(0)="E" D ^DIR K DIR
  1. I $E(IOST)="P" W $$EN^ABMVDF("IOF")
  1. I $D(IO("S")) D ^%ZISC
  1. D CLOSE^%ZISH("ABM")
  1. W "DONE"
  1. K ABME
  1. Q
  1. GETDATA ;
  1. W !!,"Searching...."
  1. K ABMPSFLG,ABMLOC
  1. K ^TMP($J,"ABMUBLST")
  1. S ABMLOC=DUZ(2)
  1. S:$G(ABMP("LDFN"))="" ABMP("LDFN")=DUZ(2)
  1. S:$G(ABMP("VDT"))="" ABMP("VDT")=DT
  1. S ABMPAR=0
  1. F S ABMPAR=$O(^BAR(90052.05,ABMPAR)) Q:+ABMPAR=0 D Q:($G(ABMPSFLG)=1)
  1. .I $D(^BAR(90052.05,ABMPAR,ABMP("LDFN"))) D
  1. ..; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this
  1. ..; visit location
  1. ..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,3)'=ABMPAR
  1. ..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,6)>ABMP("VDT")
  1. ..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,7)&($P(^(0),U,7)<ABMP("VDT"))
  1. ..S ABMLOC=ABMPAR,ABMPSFLG=1
  1. K ABMP("SITES")
  1. S ABMP("LDFN")=0
  1. F S ABMP("LDFN")=$O(^BAR(90052.05,ABMLOC,ABMP("LDFN"))) Q:'ABMP("LDFN") D
  1. .Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,3)'=ABMPAR
  1. .Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,6)>ABMP("VDT")
  1. .Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,7)&($P(^(0),U,7)<ABMP("VDT"))
  1. .S ABMP("SITES",ABMP("LDFN"))=""
  1. ;
  1. S ABMY("DT",1)=$G(ABMY("DT",1))-.5
  1. S ABMY("DT",2)=ABMY("DT",2)_".999999"
  1. S ABMDUZ2=0
  1. F S ABMDUZ2=$O(^ABMDBILL(ABMDUZ2)) Q:'ABMDUZ2 D
  1. .S ABMADIEN=$O(^AUTTLOC(DUZ(2),11,9999999),-1)
  1. .I +$G(ABMADIEN)&($P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1") Q
  1. .S ABMP("BDFN")=0
  1. .F S ABMP("BDFN")=$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"))) Q:'ABMP("BDFN") D
  1. ..S ABMP("ADT")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,5)
  1. ..Q:(ABMP("ADT")<ABMY("DT",1))
  1. ..Q:(ABMP("ADT")>ABMY("DT",2))
  1. ..Q:($D(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,0)))
  1. ..;start new abm*2.6*21 IHS/SD/SDR HEAT169752
  1. ..S ABMITYP=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)
  1. ..I +$G(ABMY("ITYPEXC"))=1&("^I^T^"[("^"_ABMITYP_"^")) Q
  1. ..;end new abm*2.6*21 IHS/SD/SDR HEAT169752
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)
  1. ..;S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,2)=$P($G(^AUTNINS($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),2)),U) ;abm*2.6*10 HEAT73780
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,2)=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,3)=$P($G(^AUTNINS($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),0)),U)
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,6)=$J($FN($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U),",",2),10)
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,7)=$$CDT^ABMDUTL($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,5))
  1. ..S ABMBILL=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
  1. ..S ABMP("LDFN")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
  1. ..S ABMP("PDFN")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,5)
  1. ..S ABMBILL=ABMBILL_$S($P($G(^ABMDPARM(ABMDUZ2,1,2)),U,4)]"":"-"_$P($G(^ABMDPARM(ABMDUZ2,1,2)),U,4),1:"")
  1. ..I $P($G(^ABMDPARM(ABMDUZ2,1,3)),U,3),$P($G(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2) S ABMBILL=ABMBILL_"-"_$P(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0),U,2)
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,8)=ABMBILL
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,9)=$P($G(^VA(200,$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,4),0)),U)
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,10)=ABMDUZ2
  1. ..;S ABMITYP=$S($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)'="":$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2),1:$P($G(^AUTNINS($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),2)),U)) ;abm*2.6*10 HEAT73780
  1. ..S ABMITYP=$S($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)'="":$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2),1:$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),".211","I"),1,"I")) ;abm*2.6*10 73780
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,11)=$P($T(@ABMITYP^ABMUVBCH),";;",2)
  1. ..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,12)=$P($G(^AUTTLOC($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3),0)),U,2)
  1. ..S ABMP("UFMS")=+$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,99),-1)
  1. ..I ABMP("UFMS")'=0 D
  1. ...S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,4)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,ABMP("UFMS"),0)),U)
  1. ...S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,5)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,ABMP("UFMS"),0)),U,2)
  1. Q
  1. WRITE ;
  1. W !!,"Creating file..."
  1. D OPEN^%ZISH("ABM",ABMPATH,ABMFN,"W")
  1. Q:POP
  1. U IO
  1. S ABMDUZ2=0
  1. W !,"Missing Bills List for "_$P($G(^AUTTLOC(DUZ(2),0)),U,2)
  1. W !,"BILL IEN^BILL ITYPE^INSURER TYPE^INSURER^UFMS TRANS^UFMS INV^BILL AMT^DT/TM APPR^BILL#^APPROV. BY^3P DUZ^ALL CAT^VISIT LOC"
  1. F S ABMDUZ2=$O(^TMP($J,"ABMUBLST",ABMDUZ2)) Q:'ABMDUZ2 D
  1. .S ABMP("BDFN")=0
  1. .F S ABMP("BDFN")=$O(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN"))) Q:'ABMP("BDFN") D
  1. ..S ABMREC=$G(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")))
  1. ..W !,ABMP("BDFN")_U_ABMREC
  1. K ^TMP($J,"ABMUBLST")
  1. Q