ABMUBLST ; IHS/SD/SDR - 3PB/UFMS Bills not export report
;;2.6;IHS 3P BILLING SYSTEM;**4,10,21**;NOV 12, 2009;Build 379
; New routine - v2.6 p4
;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
;
DT ;
W !!," ============ Entry of APPROVAL DATE Range =============",!
S DIR("A")="Enter STARTING APPROVAL DATE for the Report"
S DIR(0)="DO^::EP"
S DIR("B")="10/01/2008"
D ^DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABMY("DT",1)=Y
W !
S DIR("A")="Enter ENDING DATE for the Report"
S DIR("B")="TODAY"
D ^DIR
K DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
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
I ABMY("DT",1)<3081001 W !!,*7,"INPUT ERROR: Start Date must be on or before 10/01/2008, TRY AGAIN!",!! G DT
;start new abm*2.6*21 IHS/SD/SDR HEAT169752
EXCLUDE ;EP
W !
S DIR("A",2)="Insurer Types I (Indian Patient) and T (3P Liability) don't go to UFMS"
S DIR("A")="Exclude these Insurer Types from report as well"
S DIR(0)="Y"
S DIR("B")="YES"
D ^DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I Y=1 S ABMY("ITYPEXC")=1
K DIR
W !
;end new abm*2.6*21 IHS/SD/SDR HEAT169752
SEL ;
; Select device
S DIR(0)="F"
S DIR("A")="Enter Path"
S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
D ^DIR K DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABMPATH=Y
S DIR(0)="F",DIR("A")="Enter File Name"
D ^DIR K DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABMFN=Y
PRINT ;EP
; Callable point for queuing
S ABME("PG")=0
D GETDATA
D WRITE Q:(IOST["C")&(($G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
W !!,$$EN^ABMVDF("HIN"),"E N D O F R E P O R T",$$EN^ABMVDF("HIF"),!
I $E(IOST)="C" S DIR(0)="E" D ^DIR K DIR
I $E(IOST)="P" W $$EN^ABMVDF("IOF")
I $D(IO("S")) D ^%ZISC
D CLOSE^%ZISH("ABM")
W "DONE"
K ABME
Q
GETDATA ;
W !!,"Searching...."
K ABMPSFLG,ABMLOC
K ^TMP($J,"ABMUBLST")
S ABMLOC=DUZ(2)
S:$G(ABMP("LDFN"))="" ABMP("LDFN")=DUZ(2)
S:$G(ABMP("VDT"))="" ABMP("VDT")=DT
S ABMPAR=0
F S ABMPAR=$O(^BAR(90052.05,ABMPAR)) Q:+ABMPAR=0 D Q:($G(ABMPSFLG)=1)
.I $D(^BAR(90052.05,ABMPAR,ABMP("LDFN"))) D
..; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this
..; visit location
..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,3)'=ABMPAR
..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,6)>ABMP("VDT")
..Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,7)&($P(^(0),U,7)<ABMP("VDT"))
..S ABMLOC=ABMPAR,ABMPSFLG=1
K ABMP("SITES")
S ABMP("LDFN")=0
F S ABMP("LDFN")=$O(^BAR(90052.05,ABMLOC,ABMP("LDFN"))) Q:'ABMP("LDFN") D
.Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,3)'=ABMPAR
.Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,6)>ABMP("VDT")
.Q:$P($G(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,7)&($P(^(0),U,7)<ABMP("VDT"))
.S ABMP("SITES",ABMP("LDFN"))=""
;
S ABMY("DT",1)=$G(ABMY("DT",1))-.5
S ABMY("DT",2)=ABMY("DT",2)_".999999"
S ABMDUZ2=0
F S ABMDUZ2=$O(^ABMDBILL(ABMDUZ2)) Q:'ABMDUZ2 D
.S ABMADIEN=$O(^AUTTLOC(DUZ(2),11,9999999),-1)
.I +$G(ABMADIEN)&($P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1") Q
.S ABMP("BDFN")=0
.F S ABMP("BDFN")=$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"))) Q:'ABMP("BDFN") D
..S ABMP("ADT")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,5)
..Q:(ABMP("ADT")<ABMY("DT",1))
..Q:(ABMP("ADT")>ABMY("DT",2))
..Q:($D(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,0)))
..;start new abm*2.6*21 IHS/SD/SDR HEAT169752
..S ABMITYP=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)
..I +$G(ABMY("ITYPEXC"))=1&("^I^T^"[("^"_ABMITYP_"^")) Q
..;end new abm*2.6*21 IHS/SD/SDR HEAT169752
..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)
..;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
..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
..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,3)=$P($G(^AUTNINS($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),0)),U)
..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,6)=$J($FN($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U),",",2),10)
..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,7)=$$CDT^ABMDUTL($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,5))
..S ABMBILL=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
..S ABMP("LDFN")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
..S ABMP("PDFN")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,5)
..S ABMBILL=ABMBILL_$S($P($G(^ABMDPARM(ABMDUZ2,1,2)),U,4)]"":"-"_$P($G(^ABMDPARM(ABMDUZ2,1,2)),U,4),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)
..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,8)=ABMBILL
..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)
..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,10)=ABMDUZ2
..;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
..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
..S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,11)=$P($T(@ABMITYP^ABMUVBCH),";;",2)
..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)
..S ABMP("UFMS")=+$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,99),-1)
..I ABMP("UFMS")'=0 D
...S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,4)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,ABMP("UFMS"),0)),U)
...S $P(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,5)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,ABMP("UFMS"),0)),U,2)
Q
WRITE ;
W !!,"Creating file..."
D OPEN^%ZISH("ABM",ABMPATH,ABMFN,"W")
Q:POP
U IO
S ABMDUZ2=0
W !,"Missing Bills List for "_$P($G(^AUTTLOC(DUZ(2),0)),U,2)
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"
F S ABMDUZ2=$O(^TMP($J,"ABMUBLST",ABMDUZ2)) Q:'ABMDUZ2 D
.S ABMP("BDFN")=0
.F S ABMP("BDFN")=$O(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN"))) Q:'ABMP("BDFN") D
..S ABMREC=$G(^TMP($J,"ABMUBLST",ABMDUZ2,ABMP("BDFN")))
..W !,ABMP("BDFN")_U_ABMREC
K ^TMP($J,"ABMUBLST")
Q
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
+2 ; New routine - v2.6 p4
+3 ;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
+4 ;
DT ;
+1 WRITE !!," ============ Entry of APPROVAL DATE Range =============",!
+2 SET DIR("A")="Enter STARTING APPROVAL DATE for the Report"
+3 SET DIR(0)="DO^::EP"
+4 SET DIR("B")="10/01/2008"
+5 DO ^DIR
+6 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+7 SET ABMY("DT",1)=Y
+8 WRITE !
+9 SET DIR("A")="Enter ENDING DATE for the Report"
+10 SET DIR("B")="TODAY"
+11 DO ^DIR
+12 KILL DIR
+13 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+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 IF ABMY("DT",1)<3081001
WRITE !!,*7,"INPUT ERROR: Start Date must be on or before 10/01/2008, TRY AGAIN!",!!
GOTO DT
+17 ;start new abm*2.6*21 IHS/SD/SDR HEAT169752
EXCLUDE ;EP
+1 WRITE !
+2 SET DIR("A",2)="Insurer Types I (Indian Patient) and T (3P Liability) don't go to UFMS"
+3 SET DIR("A")="Exclude these Insurer Types from report as well"
+4 SET DIR(0)="Y"
+5 SET DIR("B")="YES"
+6 DO ^DIR
+7 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+8 IF Y=1
SET ABMY("ITYPEXC")=1
+9 KILL DIR
+10 WRITE !
+11 ;end new abm*2.6*21 IHS/SD/SDR HEAT169752
SEL ;
+1 ; Select device
+2 SET DIR(0)="F"
+3 SET DIR("A")="Enter Path"
+4 SET DIR("B")=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),"^",7)
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+7 SET ABMPATH=Y
+8 SET DIR(0)="F"
SET DIR("A")="Enter File Name"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+11 SET ABMFN=Y
PRINT ;EP
+1 ; Callable point for queuing
+2 SET ABME("PG")=0
+3 DO GETDATA
+4 DO WRITE
IF (IOST["C")&(($GET(Y)=0)!($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)))
QUIT
+5 WRITE !!,$$EN^ABMVDF("HIN"),"E N D O F R E P O R T",$$EN^ABMVDF("HIF"),!
+6 IF $EXTRACT(IOST)="C"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+7 IF $EXTRACT(IOST)="P"
WRITE $$EN^ABMVDF("IOF")
+8 IF $DATA(IO("S"))
DO ^%ZISC
+9 DO CLOSE^%ZISH("ABM")
+10 WRITE "DONE"
+11 KILL ABME
+12 QUIT
GETDATA ;
+1 WRITE !!,"Searching...."
+2 KILL ABMPSFLG,ABMLOC
+3 KILL ^TMP($JOB,"ABMUBLST")
+4 SET ABMLOC=DUZ(2)
+5 IF $GET(ABMP("LDFN"))=""
SET ABMP("LDFN")=DUZ(2)
+6 IF $GET(ABMP("VDT"))=""
SET ABMP("VDT")=DT
+7 SET ABMPAR=0
+8 FOR
SET ABMPAR=$ORDER(^BAR(90052.05,ABMPAR))
IF +ABMPAR=0
QUIT
Begin DoDot:1
+9 IF $DATA(^BAR(90052.05,ABMPAR,ABMP("LDFN")))
Begin DoDot:2
+10 ; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this
+11 ; visit location
+12 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,3)'=ABMPAR
QUIT
+13 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,6)>ABMP("VDT")
QUIT
+14 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,7)&($PIECE(^(0),U,7)<ABMP("VDT"))
QUIT
+15 SET ABMLOC=ABMPAR
SET ABMPSFLG=1
End DoDot:2
End DoDot:1
IF ($GET(ABMPSFLG)=1)
QUIT
+16 KILL ABMP("SITES")
+17 SET ABMP("LDFN")=0
+18 FOR
SET ABMP("LDFN")=$ORDER(^BAR(90052.05,ABMLOC,ABMP("LDFN")))
IF 'ABMP("LDFN")
QUIT
Begin DoDot:1
+19 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,3)'=ABMPAR
QUIT
+20 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,6)>ABMP("VDT")
QUIT
+21 IF $PIECE($GET(^BAR(90052.05,ABMPAR,ABMP("LDFN"),0)),U,7)&($PIECE(^(0),U,7)<ABMP("VDT"))
QUIT
+22 SET ABMP("SITES",ABMP("LDFN"))=""
End DoDot:1
+23 ;
+24 SET ABMY("DT",1)=$GET(ABMY("DT",1))-.5
+25 SET ABMY("DT",2)=ABMY("DT",2)_".999999"
+26 SET ABMDUZ2=0
+27 FOR
SET ABMDUZ2=$ORDER(^ABMDBILL(ABMDUZ2))
IF 'ABMDUZ2
QUIT
Begin DoDot:1
+28 SET ABMADIEN=$ORDER(^AUTTLOC(DUZ(2),11,9999999),-1)
+29 IF +$GET(ABMADIEN)&($PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1")
QUIT
+30 SET ABMP("BDFN")=0
+31 FOR
SET ABMP("BDFN")=$ORDER(^ABMDBILL(ABMDUZ2,ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:2
+32 SET ABMP("ADT")=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,5)
+33 IF (ABMP("ADT")<ABMY("DT",1))
QUIT
+34 IF (ABMP("ADT")>ABMY("DT",2))
QUIT
+35 IF ($DATA(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,0)))
QUIT
+36 ;start new abm*2.6*21 IHS/SD/SDR HEAT169752
+37 SET ABMITYP=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)
+38 IF +$GET(ABMY("ITYPEXC"))=1&("^I^T^"[("^"_ABMITYP_"^"))
QUIT
+39 ;end new abm*2.6*21 IHS/SD/SDR HEAT169752
+40 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U)=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)
+41 ;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
+42 ;abm*2.6*10 HEAT73780
SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,2)=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),".211","I"),1,"I")
+43 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,3)=$PIECE($GET(^AUTNINS($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),0)),U)
+44 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,6)=$JUSTIFY($FNUMBER($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U),",",2),10)
+45 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,7)=$$CDT^ABMDUTL($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,5))
+46 SET ABMBILL=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
+47 SET ABMP("LDFN")=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
+48 SET ABMP("PDFN")=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,5)
+49 SET ABMBILL=ABMBILL_$SELECT($PIECE($GET(^ABMDPARM(ABMDUZ2,1,2)),U,4)]"":"-"_$PIECE($GET(^ABMDPARM(ABMDUZ2,1,2)),U,4),1:"")
+50 IF $PIECE($GET(^ABMDPARM(ABMDUZ2,1,3)),U,3)
IF $PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2)
SET ABMBILL=ABMBILL_"-"_$PIECE(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0),U,2)
+51 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,8)=ABMBILL
+52 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,9)=$PIECE($GET(^VA(200,$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),1)),U,4),0)),U)
+53 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,10)=ABMDUZ2
+54 ;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
+55 ;abm*2.6*10 73780
SET ABMITYP=$SELECT($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2)'="":$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),2)),U,2),1:$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8),"
.211","I"),1,"I"))
+56 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,11)=$PIECE($TEXT(@ABMITYP^ABMUVBCH),";;",2)
+57 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,12)=$PIECE($GET(^AUTTLOC($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3),0)),U,2)
+58 SET ABMP("UFMS")=+$ORDER(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,99),-1)
+59 IF ABMP("UFMS")'=0
Begin DoDot:3
+60 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,4)=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,ABMP("UFMS"),0)),U)
+61 SET $PIECE(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")),U,5)=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),69,ABMP("UFMS"),0)),U,2)
End DoDot:3
End DoDot:2
End DoDot:1
+62 QUIT
WRITE ;
+1 WRITE !!,"Creating file..."
+2 DO OPEN^%ZISH("ABM",ABMPATH,ABMFN,"W")
+3 IF POP
QUIT
+4 USE IO
+5 SET ABMDUZ2=0
+6 WRITE !,"Missing Bills List for "_$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)
+7 WRITE !,"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"
+8 FOR
SET ABMDUZ2=$ORDER(^TMP($JOB,"ABMUBLST",ABMDUZ2))
IF 'ABMDUZ2
QUIT
Begin DoDot:1
+9 SET ABMP("BDFN")=0
+10 FOR
SET ABMP("BDFN")=$ORDER(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:2
+11 SET ABMREC=$GET(^TMP($JOB,"ABMUBLST",ABMDUZ2,ABMP("BDFN")))
+12 WRITE !,ABMP("BDFN")_U_ABMREC
End DoDot:2
End DoDot:1
+13 KILL ^TMP($JOB,"ABMUBLST")
+14 QUIT
