- 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