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

BARUTLST.m

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