- 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