BARUTLST ; IHS/SD/SDR - BAR/UFMS Transactions not export report
;;1.8;IHS ACCOUNTS RECEIVABLE;**19,20,23**;OCT 26,2005
; IHS/SD/TMM 1.8*19 3/10/10
; IHS/SD/PKD HEAT 11/10/10
;MAR 2012 P.OTTIS HEAT# 62025 FIX $ZE= <SUBSCRIPT>GETDATA+14^BARUTLST
;JUN 2012 P.OTTIS ADDED FILTER OPTION: SKIP "INGORE"-TYPE OF TRANSACTION
; SHOW "I" IF INDIAN BENEFICIARY PATIENT
;MAY 2013 P.OTTIS CHANGED HDR: INDIAN BENEFICIARY FOR INDIAN PATIENT
DT ;
;
W !!,"This report will look through all the A/R Transactions in the selected date"
W !,"range and report any that have not been transmitted to UFMS. Caution should"
W !,"be used when running this report as it could contain a substantial amount of"
W !,"data depending on your site."
W !!," ============ Entry of TRANSACTION DATE Range =============",!
S DIR("A")="Enter STARTING TRANSACTION 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 BARY("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 BARY("DT",2)=Y
I BARY("DT",1)>BARY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! H 1 G DT
I BARY("DT",1)<3081001 W !!,*7,"INPUT ERROR: Start Date must be on or after 10/01/2008, TRY AGAIN!",!! H 1 G DT
;
FILTER ;P.OTT
K DIR
S DIR(0)="SO^1:NO FILTERING;2:FILTER I-MARKED TRANSACTIONS"
S DIR("A")="Enter filtering criteria:"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" 1 NO FILTERING (SHOW ALL)"
S DIR("L",4)=" 2 Don't show transactions marked as 'IGNORE'"
S DIR("B")=1
D ^DIR
G:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="") DT
S BARFLTR=Y-1
;W !,"GOT Y=",Y," BARFLTR=",BARFLTR R ASD ;G FILTER
;
;--------------------------------------------<
SEL ;
; Select device
I $G(BARUFXMT)=1 I 'PF D PRINT Q ; IHS/SD/PKD 1.8*20 HEAT 12/3/1
S DIR(0)="F"
S DIR("A")="Enter Path"
S DIR("B")=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),0)),"^",17)
D ^DIR K DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S BARPATH=Y
S DIR(0)="F",DIR("A")="Enter File Name"
D ^DIR K DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S BARFN=Y
PRINT ;EP
; Callable point for queuing
S BARE("PG")=0
D GETDATA
D WRITE Q:(IOST["C")&(($G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
I $G(BARUFXMT)=1 Q:'PF ; IHS/SD/PKD HEAT 1.8*20 12/3/1
W !!,$$EN^BARVDF("HIN"),"E N D O F R E P O R T",$$EN^BARVDF("HIF"),!
I $E(IOST)="C" S DIR(0)="E" D ^DIR K DIR
I $E(IOST)="P" W $$EN^BARVDF("IOF")
I $D(IO("S")) D ^%ZISC
D CLOSE^%ZISH("BAR")
W "DONE"
K BARE
Q
GETDATA ;
NEW BARTMP1,BARTMPG1,BARTMPG2,BARTMP3,BARTMPIT
W !!,"Searching...."
K BARPSFLG,BARLOC
K ^TMP($J,"BARUTLST")
S BARY("DT")=$G(BARY("DT",1))-.5
S BARY("DT",2)=BARY("DT",2)_".999999"
F S BARY("DT")=$O(^BARTR(DUZ(2),"B",BARY("DT"))) Q:'BARY("DT")!(BARY("DT")>BARY("DT",2)) D
.S BARP("TRANS")=0
.F S BARP("TRANS")=$O(^BARTR(DUZ(2),"B",BARY("DT"),BARP("TRANS"))) Q:'BARP("TRANS") D
.. ;Q:($G(^BARTR(DUZ(2),BARP("TRANS"),6))'="") ;already transmitted
.. ; IHS/SD/PKD 1.8*19 Check if UFMS FileName has been set to null OR TRX never X'mitted
..Q:$P($G(^BARTR(DUZ(2),BARP("TRANS"),6)),U)'="" ;already transmitted
..Q:($$GET1^DIQ(90050.03,BARP("TRANS"),3.5,"E")=0) ;Credit-Debit
.. ;--->IND PAT
.. ;SET (BARTMP3,BARTMPIT,BARINDP)="" ;JUST IN CASE WE WILL NOT FIND THEM
.. ;SET BARTMP3=$P($G(^BARTR(DUZ(2),BARP("TRANS"),0)),U,4) ;PTR TO ACCNT FILE
.. ;IF BARTMP3]"" S BARTMPIT=$$GET1^DIQ(90050.03,BARTMP3_",",6,"I") ;'A/R ACCOUNT' PTR
.. ;IF BARTMPIT]"",$$GET1^DIQ(9999999.18,BARTMPIT,.21,"I")="I" S BARINDP=1 ;INSURER TYPE 'INDIAN PATIENT'
.. ;
.. S BARINDP=$$ISINDPAT(BARP("TRANS"))
.. IF BARFLTR=1 IF $P($G(^BARTR(DUZ(2),BARP("TRANS"),1)),U,12)="I" QUIT ;IGNORE THIS TX P.OTTIS
.. ;
.. ; MAR 2012 HEAT# 62025 FIX P.OTTIS ----------------------->
.. S BARTMP01=$G(^BARTR(DUZ(2),BARP("TRANS"),1))
.. I (($P(BARTMP01,U)'=40)&($P(BARTMP01,U)'=43)&($P(BARTMP01,U)'=993)) Q ;pymts/adjs/status change only
.. ;;;OLD CODE I (($P($G(^BARTR(DUZ(2),BARP("TRANS"),1)),U)'=40)&($P($G(^BARTR(DUZ(2),BARP("TRANS"),1)),U)'=43)&($P($G(^BARTR(DUZ(2),BARP("TRANS"),1)),U)'=993)) Q ;pymts/adjs/status change only
.. ;;;OLD CODE S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U)=$P($G(^BARBL(DUZ(2),$P($G(^BARTR(DUZ(2),BARP("TRANS"),0)),U,4),0)),U) ;bill#
.. S BARTMP02=$G(^BARTR(DUZ(2),BARP("TRANS"),0))
.. S BARTMP03=$P(BARTMP02,U,4) IF BARTMP03="" QUIT
.. S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U)=$P($G(^BARBL(DUZ(2),BARTMP03,0)),U) ;bill#
.. ;------------------------------------------------------------<
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,2)=$$GET1^DIQ(90050.02,$P($G(^BARTR(DUZ(2),BARP("TRANS"),0)),U,6),".01","E") ;A/R acct
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,3)=$$GET1^DIQ(90050.02,$P($G(^BARTR(DUZ(2),BARP("TRANS"),0)),U,6),"1.08","E") ;ins type
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,4)=$$GET1^DIQ(90050.03,BARP("TRANS"),3.6,"I") ;payment
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,5)=$$GET1^DIQ(90050.03,BARP("TRANS"),3.7,"I") ;adj
..I $$GET1^DIQ(90050.03,BARP("TRANS"),102,"E")="PAYMENT CREDIT" D
...S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,5)=$P(^TMP($J,"BARUTLST",BARP("TRANS")),U,4)
...S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,4)=""
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,6)=$$GET1^DIQ(90050.03,BARP("TRANS"),3.5,"E") ;credit-debit
.. ;
..S BARTTYP=$$GET1^DIQ(90050.03,BARP("TRANS"),101,"I") ;trans type
..;status change transactions - treat like adjs
..I BARTTYP=993 S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,5)=$$GET1^DIQ(90050.03,BARP("TRANS"),3.5,"E")
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,7)=$S(BARTTYP=40:"PYMT",BARTTYP=43:"ADJ",BARTTYP=993:"SCHNG",1:"") ;trans type
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,8)=$$GET1^DIQ(90051.01,$$GET1^DIQ(90050.03,BARP("TRANS"),14,"I"),".01","E") ;C.batch
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,9)=$$GET1^DIQ(90050.03,BARP("TRANS"),15,"E") ;C.item
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,10)=$$GET1^DIQ(90051.01,$$GET1^DIQ(90050.03,BARP("TRANS"),14,"I"),28,"E") ;TDN
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,11)=$$CDT^BARDUTL($P($G(^BARBL(DUZ(2),$P($G(^BARTR(DUZ(2),BARP("TRANS"),0)),U,4),0)),U,18)) ;3p approval date
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,12)=$P($G(^BARTR(DUZ(2),BARP("TRANS"),6)),U) ;UFMS export file
..S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,13)=$P($G(^BARBL(DUZ(2),$P($G(^BARTR(DUZ(2),BARP("TRANS"),0)),U,4),1)),U,14)
..IF BARINDP S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U,14)="I" ;P.OTT
Q
WRITE ;EP
; IHS/SD/PKD 10/15/10 Called from BARUFXMT
I $G(BARUFXMT)=1 Q:'PF ; IHS/SD/PKD 1.8*20 HEAT 12/3/10
W !!,"Creating file..."
I $G(BARPATH)'="" D
. D OPEN^%ZISH("BAR",BARPATH,BARFN,"W")
Q:POP
U IO
S BARDUZ2=0
W !,"Missing Transaction List for "_$P($G(^AUTTLOC(DUZ(2),0)),U,2)
W !,"TRANS IEN^BILL#^A/R ACCT^INS TYPE^PYMT^ADJ^CR-DEB^TRANS TYPE^CBATCH^CITEM^TDN^3P APPRV DT^UFMS EXP FILE^VISIT TYPE^INDIAN PATIENT"
S BARP("TRANS")=0
F S BARP("TRANS")=$O(^TMP($J,"BARUTLST",BARP("TRANS"))) Q:'BARP("TRANS") D
.S BARREC=$G(^TMP($J,"BARUTLST",BARP("TRANS")))
.W !,BARP("TRANS")_U_BARREC
Q:$G(BARUFXMT)=1 ; Called from ^BARUFXMT which wants the ^TMP($J data ;IHS/SD/PKD 1.8*20
K ^TMP($J,"BARUTLST")
Q
QUE ;QUE TO TASKMAN
S ZTRTN="PRINT^BARUTLST"
S ZTDESC="BAR UFMS Transaction Transmit Check"
S ZTSAVE("BAR*")=""
K ZTSK
D ^%ZTLOAD
W:$G(ZSK) !,"Task # ",ZTSK," queued.",!
Q
ISINDPAT(BARTRIEN) ;EP - IS BEN OR NO INS TYP
NEW BARTR0,BARBL,BARAC,BARITYP,BARXX
S BARTR0=$G(^BARTR(DUZ(2),BARTRIEN,0))
S BARBL=$P(BARTR0,U,4)
I BARBL="" Q 0 ;NO BILL FOUND FOR THIS TX
S BARXX=$G(^BARBL(DUZ(2),BARBL,0))
S BARAC=$P(BARXX,U,3) ;A/R Account IEN
S BARITYP=$$GET1^DIQ(90050.02,BARAC,1.08) ;Ins Typ
Q BARITYP="INDIAN PATIENT"
Q
BARUTLST ; IHS/SD/SDR - BAR/UFMS Transactions not export report
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19,20,23**;OCT 26,2005
+2 ; IHS/SD/TMM 1.8*19 3/10/10
+3 ; IHS/SD/PKD HEAT 11/10/10
+4 ;MAR 2012 P.OTTIS HEAT# 62025 FIX $ZE= <SUBSCRIPT>GETDATA+14^BARUTLST
+5 ;JUN 2012 P.OTTIS ADDED FILTER OPTION: SKIP "INGORE"-TYPE OF TRANSACTION
+6 ; SHOW "I" IF INDIAN BENEFICIARY PATIENT
+7 ;MAY 2013 P.OTTIS CHANGED HDR: INDIAN BENEFICIARY FOR INDIAN PATIENT
DT ;
+1 ;
+2 WRITE !!,"This report will look through all the A/R Transactions in the selected date"
+3 WRITE !,"range and report any that have not been transmitted to UFMS. Caution should"
+4 WRITE !,"be used when running this report as it could contain a substantial amount of"
+5 WRITE !,"data depending on your site."
+6 WRITE !!," ============ Entry of TRANSACTION DATE Range =============",!
+7 SET DIR("A")="Enter STARTING TRANSACTION DATE for the Report"
+8 SET DIR(0)="DO^::EP"
+9 SET DIR("B")="10/01/2008"
+10 DO ^DIR
+11 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+12 SET BARY("DT",1)=Y
+13 WRITE !
+14 SET DIR("A")="Enter ENDING DATE for the Report"
+15 SET DIR("B")="TODAY"
+16 DO ^DIR
+17 KILL DIR
+18 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+19 SET BARY("DT",2)=Y
+20 IF BARY("DT",1)>BARY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
HANG 1
GOTO DT
+21 IF BARY("DT",1)<3081001
WRITE !!,*7,"INPUT ERROR: Start Date must be on or after 10/01/2008, TRY AGAIN!",!!
HANG 1
GOTO DT
+22 ;
FILTER ;P.OTT
+1 KILL DIR
+2 SET DIR(0)="SO^1:NO FILTERING;2:FILTER I-MARKED TRANSACTIONS"
+3 SET DIR("A")="Enter filtering criteria:"
+4 SET DIR("L",1)="Select one of the following:"
+5 SET DIR("L",2)=""
+6 SET DIR("L",3)=" 1 NO FILTERING (SHOW ALL)"
+7 SET DIR("L",4)=" 2 Don't show transactions marked as 'IGNORE'"
+8 SET DIR("B")=1
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")
GOTO DT
+11 SET BARFLTR=Y-1
+12 ;W !,"GOT Y=",Y," BARFLTR=",BARFLTR R ASD ;G FILTER
+13 ;
+14 ;--------------------------------------------<
SEL ;
+1 ; Select device
+2 ; IHS/SD/PKD 1.8*20 HEAT 12/3/1
IF $GET(BARUFXMT)=1
IF 'PF
DO PRINT
QUIT
+3 SET DIR(0)="F"
+4 SET DIR("A")="Enter Path"
+5 SET DIR("B")=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),0)),"^",17)
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+8 SET BARPATH=Y
+9 SET DIR(0)="F"
SET DIR("A")="Enter File Name"
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+12 SET BARFN=Y
PRINT ;EP
+1 ; Callable point for queuing
+2 SET BARE("PG")=0
+3 DO GETDATA
+4 DO WRITE
IF (IOST["C")&(($GET(Y)=0)!($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)))
QUIT
+5 ; IHS/SD/PKD HEAT 1.8*20 12/3/1
IF $GET(BARUFXMT)=1
IF 'PF
QUIT
+6 WRITE !!,$$EN^BARVDF("HIN"),"E N D O F R E P O R T",$$EN^BARVDF("HIF"),!
+7 IF $EXTRACT(IOST)="C"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+8 IF $EXTRACT(IOST)="P"
WRITE $$EN^BARVDF("IOF")
+9 IF $DATA(IO("S"))
DO ^%ZISC
+10 DO CLOSE^%ZISH("BAR")
+11 WRITE "DONE"
+12 KILL BARE
+13 QUIT
GETDATA ;
+1 NEW BARTMP1,BARTMPG1,BARTMPG2,BARTMP3,BARTMPIT
+2 WRITE !!,"Searching...."
+3 KILL BARPSFLG,BARLOC
+4 KILL ^TMP($JOB,"BARUTLST")
+5 SET BARY("DT")=$GET(BARY("DT",1))-.5
+6 SET BARY("DT",2)=BARY("DT",2)_".999999"
+7 FOR
SET BARY("DT")=$ORDER(^BARTR(DUZ(2),"B",BARY("DT")))
IF 'BARY("DT")!(BARY("DT")>BARY("DT",2))
QUIT
Begin DoDot:1
+8 SET BARP("TRANS")=0
+9 FOR
SET BARP("TRANS")=$ORDER(^BARTR(DUZ(2),"B",BARY("DT"),BARP("TRANS")))
IF 'BARP("TRANS")
QUIT
Begin DoDot:2
+10 ;Q:($G(^BARTR(DUZ(2),BARP("TRANS"),6))'="") ;already transmitted
+11 ; IHS/SD/PKD 1.8*19 Check if UFMS FileName has been set to null OR TRX never X'mitted
+12 ;already transmitted
IF $PIECE($GET(^BARTR(DUZ(2),BARP("TRANS"),6)),U)'=""
QUIT
+13 ;Credit-Debit
IF ($$GET1^DIQ(90050.03,BARP("TRANS"),3.5,"E")=0)
QUIT
+14 ;--->IND PAT
+15 ;SET (BARTMP3,BARTMPIT,BARINDP)="" ;JUST IN CASE WE WILL NOT FIND THEM
+16 ;SET BARTMP3=$P($G(^BARTR(DUZ(2),BARP("TRANS"),0)),U,4) ;PTR TO ACCNT FILE
+17 ;IF BARTMP3]"" S BARTMPIT=$$GET1^DIQ(90050.03,BARTMP3_",",6,"I") ;'A/R ACCOUNT' PTR
+18 ;IF BARTMPIT]"",$$GET1^DIQ(9999999.18,BARTMPIT,.21,"I")="I" S BARINDP=1 ;INSURER TYPE 'INDIAN PATIENT'
+19 ;
+20 SET BARINDP=$$ISINDPAT(BARP("TRANS"))
+21 ;IGNORE THIS TX P.OTTIS
IF BARFLTR=1
IF $PIECE($GET(^BARTR(DUZ(2),BARP("TRANS"),1)),U,12)="I"
QUIT
+22 ;
+23 ; MAR 2012 HEAT# 62025 FIX P.OTTIS ----------------------->
+24 SET BARTMP01=$GET(^BARTR(DUZ(2),BARP("TRANS"),1))
+25 ;pymts/adjs/status change only
IF (($PIECE(BARTMP01,U)'=40)&($PIECE(BARTMP01,U)'=43)&($PIECE(BARTMP01,U)'=993))
QUIT
+26 ;;;OLD CODE I (($P($G(^BARTR(DUZ(2),BARP("TRANS"),1)),U)'=40)&($P($G(^BARTR(DUZ(2),BARP("TRANS"),1)),U)'=43)&($P($G(^BARTR(DUZ(2),BARP("TRANS"),1)),U)'=993)) Q ;pymts/adjs/status change only
+27 ;;;OLD CODE S $P(^TMP($J,"BARUTLST",BARP("TRANS")),U)=$P($G(^BARBL(DUZ(2),$P($G(^BARTR(DUZ(2),BARP("TRANS"),0)),U,4),0)),U) ;bill#
+28 SET BARTMP02=$GET(^BARTR(DUZ(2),BARP("TRANS"),0))
+29 SET BARTMP03=$PIECE(BARTMP02,U,4)
IF BARTMP03=""
QUIT
+30 ;bill#
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U)=$PIECE($GET(^BARBL(DUZ(2),BARTMP03,0)),U)
+31 ;------------------------------------------------------------<
+32 ;A/R acct
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,2)=$$GET1^DIQ(90050.02,$PIECE($GET(^BARTR(DUZ(2),BARP("TRANS"),0)),U,6),".01","E")
+33 ;ins type
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,3)=$$GET1^DIQ(90050.02,$PIECE($GET(^BARTR(DUZ(2),BARP("TRANS"),0)),U,6),"1.08","E")
+34 ;payment
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,4)=$$GET1^DIQ(90050.03,BARP("TRANS"),3.6,"I")
+35 ;adj
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,5)=$$GET1^DIQ(90050.03,BARP("TRANS"),3.7,"I")
+36 IF $$GET1^DIQ(90050.03,BARP("TRANS"),102,"E")="PAYMENT CREDIT"
Begin DoDot:3
+37 SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,5)=$PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,4)
+38 SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,4)=""
End DoDot:3
+39 ;credit-debit
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,6)=$$GET1^DIQ(90050.03,BARP("TRANS"),3.5,"E")
+40 ;
+41 ;trans type
SET BARTTYP=$$GET1^DIQ(90050.03,BARP("TRANS"),101,"I")
+42 ;status change transactions - treat like adjs
+43 IF BARTTYP=993
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,5)=$$GET1^DIQ(90050.03,BARP("TRANS"),3.5,"E")
+44 ;trans type
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,7)=$SELECT(BARTTYP=40:"PYMT",BARTTYP=43:"ADJ",BARTTYP=993:"SCHNG",1:"")
+45 ;C.batch
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,8)=$$GET1^DIQ(90051.01,$$GET1^DIQ(90050.03,BARP("TRANS"),14,"I"),".01","E")
+46 ;C.item
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,9)=$$GET1^DIQ(90050.03,BARP("TRANS"),15,"E")
+47 ;TDN
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,10)=$$GET1^DIQ(90051.01,$$GET1^DIQ(90050.03,BARP("TRANS"),14,"I"),28,"E")
+48 ;3p approval date
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,11)=$$CDT^BARDUTL($PIECE($GET(^BARBL(DUZ(2),$PIECE($GET(^BARTR(DUZ(2),BARP("TRANS"),0)),U,4),0)),U,18))
+49 ;UFMS export file
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,12)=$PIECE($GET(^BARTR(DUZ(2),BARP("TRANS"),6)),U)
+50 SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,13)=$PIECE($GET(^BARBL(DUZ(2),$PIECE($GET(^BARTR(DUZ(2),BARP("TRANS"),0)),U,4),1)),U,14)
+51 ;P.OTT
IF BARINDP
SET $PIECE(^TMP($JOB,"BARUTLST",BARP("TRANS")),U,14)="I"
End DoDot:2
End DoDot:1
+52 QUIT
WRITE ;EP
+1 ; IHS/SD/PKD 10/15/10 Called from BARUFXMT
+2 ; IHS/SD/PKD 1.8*20 HEAT 12/3/10
IF $GET(BARUFXMT)=1
IF 'PF
QUIT
+3 WRITE !!,"Creating file..."
+4 IF $GET(BARPATH)'=""
Begin DoDot:1
+5 DO OPEN^%ZISH("BAR",BARPATH,BARFN,"W")
End DoDot:1
+6 IF POP
QUIT
+7 USE IO
+8 SET BARDUZ2=0
+9 WRITE !,"Missing Transaction List for "_$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)
+10 WRITE !,"TRANS IEN^BILL#^A/R ACCT^INS TYPE^PYMT^ADJ^CR-DEB^TRANS TYPE^CBATCH^CITEM^TDN^3P APPRV DT^UFMS EXP FILE^VISIT TYPE^INDIAN PATIENT"
+11 SET BARP("TRANS")=0
+12 FOR
SET BARP("TRANS")=$ORDER(^TMP($JOB,"BARUTLST",BARP("TRANS")))
IF 'BARP("TRANS")
QUIT
Begin DoDot:1
+13 SET BARREC=$GET(^TMP($JOB,"BARUTLST",BARP("TRANS")))
+14 WRITE !,BARP("TRANS")_U_BARREC
End DoDot:1
+15 ; Called from ^BARUFXMT which wants the ^TMP($J data ;IHS/SD/PKD 1.8*20
IF $GET(BARUFXMT)=1
QUIT
+16 KILL ^TMP($JOB,"BARUTLST")
+17 QUIT
QUE ;QUE TO TASKMAN
+1 SET ZTRTN="PRINT^BARUTLST"
+2 SET ZTDESC="BAR UFMS Transaction Transmit Check"
+3 SET ZTSAVE("BAR*")=""
+4 KILL ZTSK
+5 DO ^%ZTLOAD
+6 IF $GET(ZSK)
WRITE !,"Task # ",ZTSK," queued.",!
+7 QUIT
ISINDPAT(BARTRIEN) ;EP - IS BEN OR NO INS TYP
+1 NEW BARTR0,BARBL,BARAC,BARITYP,BARXX
+2 SET BARTR0=$GET(^BARTR(DUZ(2),BARTRIEN,0))
+3 SET BARBL=$PIECE(BARTR0,U,4)
+4 ;NO BILL FOUND FOR THIS TX
IF BARBL=""
QUIT 0
+5 SET BARXX=$GET(^BARBL(DUZ(2),BARBL,0))
+6 ;A/R Account IEN
SET BARAC=$PIECE(BARXX,U,3)
+7 ;Ins Typ
SET BARITYP=$$GET1^DIQ(90050.02,BARAC,1.08)
+8 QUIT BARITYP="INDIAN PATIENT"
+9 QUIT
