BAREDP00 ; IHS/SD/LSL - AR ERA AUTO-POSTIEG ; 01/30/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,5,6,7,10,17,20,21,23**;OCT 26,2005
;P23: JAN 2013 P.OTTIS: AUTO-SELECT THE TRANSPORT TYPE ($$FORMAT)
;
Q
TSEL ;EP TRANSPORT SELECT (DEFUNCT)
W !
K DIC,DA
S DIC=$$DIC^XBDIQ1(90056.01)
S DIC(0)="AEQM"
K DD,DO
D ^DIC
S TRDA=+Y
S TRNAME=$P(Y,U,2)
Q
;THIS IS ENTRY POINT FOR BOTH 4010 & 5010 TRANSPORT TYPES
INSTALL ;EP -Load New Import
D SIG^XUSESIG
Q:X1=""
I $G(DUZ(2))="" D Q
. W !!,"Check your DUZ setup."
. H 4
I '$D(^BAREDI("I",DUZ(2),0)) S ^BAREDI("I",DUZ(2),0)="A/R EDI IMPORT^90056.02^^^"
K ^TMP($J,"ERA")
S DIR(0)="F"
S DIR("A")="Enter the directory path for the transport file"
S BARPATH=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),0)),U,17)
S DIR("B")=BARPATH
S DIR("?")="For example enter '/usr/mydir/'"
D ^DIR
K DIR
Q:$D(DIRUT)
; Path
S XBDIR=X
D FNAME^BAREDIUT
S HSTFILE=$G(XBFN)
Q:HSTFILE=""
W !!,"CHECKING FILE FORMAT....."
S BARCTRL=0
S POP=0 D READ(XBDIR,HSTFILE) I POP QUIT
S BARRET=$$FORMAT(BARREC) I +BARRET D QUIT ;------------------------------>
. W !,"The file ",HSTFILE," in directory ",XBDIR
. W !,"is not a Remittance Advice. It cannot be loaded."
. W !,"Reason: "
. I BARRET=1 W " missing 'ISA' id "
. I BARRET=2 W " missing 'HP' id "
. I BARRET=3 W " UNKNOWN TRANSPORT FILE TYPE."
. D EOP^BARUTL(1)
. Q
S TRNAME=$P(BARRET,"^",2)
S TRDA=$O(^BAREDI("1T","B",TRNAME,""))
W !,"File type: ",TRNAME," FILE FORMAT OKAY."
D READ^BAR50PA1(XBDIR,HSTFILE) ;Read file into ^TMP($J,"ERA")
Q:+$G(POP)
I TRNAME["5010" D 5010^BAR50P00 Q
D 4010 Q
Q ;-------------------------------------------------------
4010 S ANS="Y"
K FILE ;bar*1.8*20
I $D(^BAREDI("I",DUZ(2),"C",HSTFILE)) D Q:ANS="N"
. S IEN=$O(^BAREDI("I",DUZ(2),"C",HSTFILE,9999999),-1)
. S LOADDT=""
. S:(+IEN'=0) LOADDT=$$GET1^DIQ(90056.02,IEN,".02"),FILE=$$GET1^DIQ(90056.02,IEN,".01")
. W !!,"This file was previously loaded on "_LOADDT_" as",!?2,"file "_FILE
. W !!,?5," You can exit and review the import by entering"
. W !,?5," the filename in the View Import Header option.",!
. W !,"NOTE: reloading a file will create duplicate entries in the A/R EDI Check!"
. W !,"Proceed with caution"
. S BARFLG=1
. S BARFLG=$$POSTCHK^BAREDP0A(IEN)
. I BARFLG=1 W !,"Nothing has been posted from this ERA. If you reload it, the original file",!,"will be replaced with this file. Any edits done in REV will be lost."
. I BARFLG=0 D S ANS="N" Q
. . W !!!,"Part of this file has been POSTED and is therefore not eligible for reload."
. S DIR(0)="Y"
. S DIR("A")="Do you wish to reload this file"
. S DIR("B")="N"
. S DIR("?")="Enter 'Y' to re-install transport file: "
. D ^DIR
. I $D(DIRUT)!Y=0 S ANS="N" Q
. I BARFLG=1 D
. . K DIR
. . S DIR(0)="Y"
. . S DIR("A")="Are you sure?"
. . S DIR("B")="N"
. . S DIR("?")="Enter 'Y' to re-install transport file: "
. . D ^DIR
. I BARFLG=1 Q:$D(DIRUT)!(ANS'="Y")
. K DIR
. S ANS=$S(+Y:"Y",1:"N")
. Q:ANS'="Y"
Q:ANS'="Y"
K XBY,XBGUI
W !!,"File",?25,"Directory",?50,"Transport"
W !,HSTFILE,?25,XBDIR,?50,TRNAME,!!
S DIR(0)="Y"
S DIR("A")="Do you want to proceed"
S DIR("B")="N"
S DIR("?")="Enter 'Y' to install transport file: "
D ^DIR
K DIR
Q:$D(DIRUT)
Q:'+Y
I +$G(BARFLG)=1 D
. S DIK=$$DIC^XBDIQ1(90056.02)
. S DA=IEN
. D ^DIK
S BARCTRL=0
D READ^BAREDPA1(XBDIR,HSTFILE) ;Read file into ^TMP($J,"ERA")
Q:+$G(POP)
D EOP^BARUTL(1)
I '$D(^TMP($J,"ERA")) D Q
. W !,"The file ",HSTFILE," in directory ",XBDIR
. W !,"Appears to be an empty file."
. W !,"Empty files are not HIPAA compliant."
. W !,"Inform your source and request a HIPAA compliant file"
. W !,"Please contact your supervisor for assistance."
. D EOP^BARUTL(1)
D CLEAR^VALM1
S X=$O(^TMP($J,"ERA",""),-1)
W !,"LINE COUNT LOADED: ",X,!
H 3
I X'>0 G INSTALL
K DIC
S DIC=$$DIC^XBDIQ1(90056.02)
S DIC(0)="EL"
S X=HSTFILE
S:$G(FILE) DINUM=($P(FILE,"_")-1000) ;bar*1.8*20
K DD,DO D FILE^DICN
S IMPDA=+Y
K DIC
I +Y<1 D Q
. W !!,"File not created for transport"
. D EOP^BARUTL(1)
D NOW^%DTC
S X=X+17000000
S DATE=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
D YX^%DTC
S DATM=Y
S SEQ=1000+IMPDA
S TNAME=SEQ_"_ERA_"_DATE
W TNAME,! H 3
K DIE,DR,DA
S DIE=$$DIC^XBDIQ1(90056.02)
S DA=IMPDA
S DR=".01///^S X=TNAME"
S DR=DR_";.04////^S X=XBDIR"
S DR=DR_";.05////^S X=HSTFILE"
S DR=DR_";.02////^S X=DATM"
S DR=DR_";.03////^S X=TRDA"
D ^DIE
;Convert ^TMP($J,"ERA") to ^BAREDI("I",DUZ(2))
S ^BAREDI("I",DUZ(2),IMPDA,10,0)=""
S BARCNTL=0
I +BARCTRL D
. S BARESEP=$A(BARESEP)
. S BARSSEP=$A(BARSSEP)
. S BARCSEP=$A(BARCSEP)
S X="" F S X=$O(^TMP($J,"ERA",X)) Q:X="" D
. S BARTMP=^TMP($J,"ERA",X)
. I +BARCTRL D ;Separators=ctrl char
. . F I=1:1:$L(BARTMP) D
. . .I (($A($E(BARTMP,I))<32)!($A($E(BARTMP,I))>126)),$A(BARTMP,I)=BARSSEP S BARTMP=$E(BARTMP,1,I-1)_"~"_$E(BARTMP,I+1,999) Q
. . .I (($A($E(BARTMP,I))<32)!($A($E(BARTMP,I))>126)),$A(BARTMP,I)=BARESEP S BARTMP=$E(BARTMP,1,I-1)_"*"_$E(BARTMP,I+1,999) Q
. . .I (($A($E(BARTMP,I))<32)!($A($E(BARTMP,I))>126)),$A(BARTMP,I)=BARCSEP S BARTMP=$E(BARTMP,1,I-1)_":"_$E(BARTMP,I+1,999) Q
. . .I ($A($E(BARTMP,I))<32)!($A($E(BARTMP,I))>126) S BARTMP=$E(BARTMP,1,I-1)_$E(BARTMP,I+1,999)
. I '+BARCTRL D
. . F I=1:1:$L(BARTMP) D
. . . I ($A($E(BARTMP,I))<32)!($A($E(BARTMP,I))>126) S BARTMP=$E(BARTMP,1,I-1)_$E(BARTMP,I+1,999)
. I '+$L(BARTMP) Q
. S BARCNTL=BARCNTL+1
. S ^BAREDI("I",DUZ(2),IMPDA,10,BARCNTL,0)=BARTMP
REDO ;EP entry for mid stream testing
S SUCC=""
S NRECS=$O(^TMP($J,"ERA",""),-1)
I NRECS="" S NRECS="No",SUCC="un"
W !,"The ",XBFN," file has been "_SUCC_"successful in updating"
W !,"the transport global"
W !!,NRECS," records updated"
Q:NRECS="No"
W !,"PROCESSING",!,"TRANSPORT FILE: ",?20,XBFN
W !,"IMPORT NAME: ",?20,TNAME,!!
; Split image into segmts
W !,"Starting stage 1 of 3 -> Extract data from transport to segments"
D EN^BAREDP01(TRDA,IMPDA)
W !,"Stage 1 -> Complete"
; Parse segmts into elemts & vals
W !!,"Starting stage 2 of 3 -> Parse segments into elements & values"
D EN^BAREDP02(TRDA,IMPDA)
D CHKS^BAREDP02(IMPDA) ;bar*1.8*20 REQ2
W !," Stand by to print TRN - Check Number/Check Amount Report..."
D EN1^BAREDPCS ;bar*1.8*20 REQ2
W !,"Stage 2 -> Complete"
; Build postable clms
W !!,"Starting stage 3 of 3 -> Build postable claims"
H 1
D EN^BAREDP03(TRDA,IMPDA)
W !,"Stage 3 -> Complete"
D EOP^BARUTL(1) ;bar*1.8*20
Q
PLB ;Chk for PLB/Pymt Reversals ;MRS:BAR*1.8*10 D159
;start new bar*1.8*20 REQ4
D SELFL
I Y'>0 Q
;IHS/SD/TPF 8/22/2001 BAR*1.8*21 5010
I TRNAME[("5010") D PLB^BAR50P00 Q
S BARCNT=0,I=0
F S I=$O(^BAREDI("I",DUZ(2),IMPDA,5,I)) Q:'I D
. S BARCNT=BARCNT+1
I BARCNT=1 S BARCKIEN=$O(^BAREDI("I",DUZ(2),IMPDA,5,0)),BARCHK=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)
I BARCNT>1 D SELCK ;if 1+ chk, pick 1
I +$G(BARCKIEN)'>0 Q
S BARQT=0,BARQUIT=1
I $D(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M")) D
. S CLMDA=0
. F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M",CLMDA)) Q:'CLMDA D Q:BARQT
. .I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)=BARCHK S BARQT=1
. Q:'BARQT
. W !!,"Bill matching for this check has already been done."
. K DIR
. S DIR(0)="Y"
. S DIR("A")="Do you want to do matching again"
. D ^DIR K DIR
. S BARQUIT=+Y
Q:'BARQUIT
I $P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U,7)="" W !!,"NOTE: This check has NOT been matched to a batch/item",!
W !,"I will begin bill matching..."
H 1
D EN^BAREDP04(TRDA,IMPDA)
I '+$G(QFLG) W !!,"Matching complete"
I +$G(QFLG) W !!,"Matching NOT complete"
S DIE=$$DIC^XBDIQ1(90056.02)
S DA=IMPDA
S DR=".08////M"
D ^DIE
K DIR
S DIR(0)="E"
S DIR("A")="<CR> - Continue"
D ^DIR
D CLEAR^VALM1
D CLNUP
Q
FORMAT(BARREC) ;
; Verify file loading is HIPAA 835 if Transport HIPAA 835
; Return >0^STRING if wrong format
; Return 0^TRANSPORT_TYPE if correct format
K BARSSEP,BARESEP,BARCSEP
N BARTMP,BARGS08,X,I,BARERR
S BARCTRL=0,BARERR=0
S BARTMP=BARREC
I $E(BARTMP,1,3)'="ISA" S BARERR=1 Q BARERR ;all X12 messages start w/ ISA
S BARESEP=$E(BARTMP,4) ;Element separator
I $A(BARESEP)<32!($A(BARESEP)>126) S BARCTRL=1
S BARSSEP=$E(BARTMP,106) ;Segment separator
I $A(BARSSEP)<32!($A(BARSSEP)>126) S BARCTRL=1
S BARCSEP=$E(BARTMP,105) ;Component separator
I $A(BARCSEP)<32!($A(BARCSEP)>126) S BARCTRL=1
I DUZ=902 W 1/0
I $E($P(BARTMP,BARSSEP,2),4,5)'="HP" S BARERR=2 Q BARERR ;GS01 must be HP for 835
S BARGS08=$P($P(BARTMP,BARSSEP,2),BARESEP,9)
I BARGS08["004010X091" Q 0_"^HIPAA 835 v4010"
I BARGS08["005010X221" Q 0_"^HIPAA 835 v5010"
Q 3_"^"_BARGS08
;
REVIEW ;EP
I $G(DUZ(2))="" D Q
. W !!,"Check your DUZ setup."
. D EOP^BARUTL(1)
D SELFL
I Y'>0 Q
I TRNAME[("5010") D REVIEW^BAR50P00 Q
D ERACHECK^BAREDP09
I $O(BARCHK(9999),-1)=1 S BARCKIEN=$O(^BAREDI("I",DUZ(2),IMPDA,5,0)),BARCHK=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)
I $O(BARCHK(9999),-1)>1 D SELCK
I +$G(BARCKIEN)'>0 Q
;Review screen
D EN^BAREDP05
I TRNAME["HIPAA" D ;Mark chk as reviewed
.D NOW^%DTC
.S BARDTREV=%
.K DIE,DIC,DA,DR,X,Y
.S DIE="^BARECHK("
.S DA=$P(BARCHK(BARCKIEN),U,5)
.S DR=".05///^S X=BARDTREV"
.S DR=DR_";.06////^S X=DUZ"
.D ^DIE
D CLNUP
Q
POST ; EP
I $G(DUZ(2))="" D Q
.W !!,"Check your DUZ setup."
.D EOP^BARUTL(1)
D SELFL
I Y'>0 Q
I TRNAME[("5010") D POST^BAR50P00 Q
I TRNAME["HIPAA" D Q
.S BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"POST")
.Q:'+BARCKIEN
.D POST^BAREDP08(BARCKIEN)
;Get batch/item info
I NOBTCH D BTCHCHK
I 'NOBTCH D
.D BTCHDISP
.W !
.S DIR(0)="Y"
.S DIR("A")="Do you want to select a different batch"
.S DIR("B")="N"
.S DIR("?")="Enter 'Y' to select a different batch "
.D ^DIR
.K DIR
.Q:$D(DIRUT)
.S NOBTCH=1
.I X="Y" D BTCHCHK
D CLEAR^VALM1
I 'NOBTCH D BTCHDISP
I +$G(BARCOL),+$G(BARITM)
E D
.W !,"Batch & Item not selected ",!,"Adjustments only will be made,",!!
.H 2
.K BARCOL,BARITM
.K DR,DIE,DA,DIC
.S DIE=$$DIC^XBDIQ1(90056.02)
.S DA=IMPDA
.S DR=".06///@;.07///@"
.D ^DIE
POSTA ;EP POST
W !
S DIR(0)="Y"
S DIR("A")="DO YOU WANT TO POST CLAIMS NOW."
S DIR("A",1)="The above information details the transport and batch that"
S DIR("A",2)="has been selected to post matched claims to the A/R database"
S DIR("B")="N"
S DIR("?")="Enter 'Y' to load matched claims: "
D ^DIR
K DIR
Q:$D(DIRUT)
I X="Y" D
.D EN^BAREDP06(TRDA,IMPDA)
.S BARRAYGO=0 ;"Roll-over as you go" flag set to no
.D EN^BARROLL ;Loops BARROLL array & marks for rollback
.K BARROLL
D CLNUP
Q
VIEW ; EP
I $G(DUZ(2))="" D Q
.W !!,"Check your DUZ setup."
.D EOP^BARUTL(1)
N RPTLOOK S RPTLOOK=1
D SELFL
I Y'>0 Q
I TRNAME[("5010") D VIEW^BAR50P00 Q
D VIEW^BAREDIUT(TRDA,IMPDA)
D CLNUP
Q
REPORT ; EP
I $G(DUZ(2))="" D Q
.W !!,"Check your DUZ setup."
.D EOP^BARUTL(1)
N RPTLOOK S RPTLOOK=1 ;Allow rpts to view ERA batches older than 3rd qtr past
;RPTLOOK will be used to BARPST to bypass chk HEAT10729 BAR*1.8*17 PKD 3/30/10
D SELFL
I Y'>0 Q
I TRNAME[("5010") D REPORT^BAR50P00 Q
I TRNAME["HIPAA" D Q:'+BARCKIEN S BARCHK=$$GET1^DIQ(90056.22,BARCKIEN,.01)
.S BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"REPORT")
I TRNAME["HIPAA",+BARCKIEN D EN^BAREDP10
I TRNAME'["HIPAA" D EN^BAREDP07
D CLNUP
Q
;new code bar*1.8*20 REQ8
NFOUND ; EP
I $G(DUZ(2))="" D Q
.W !!,"Check your DUZ setup."
.D EOP^BARUTL(1)
N RPTLOOK S RPTLOOK=1 ;Allow rpts to view ERA batches older than 3rd qtr past
D SELFL
I Y'>0 Q
I TRNAME[("5010") D NFOUND^BAR50P00 Q
I TRNAME["HIPAA" D EN^BAREDP12
D CLNUP
Q
SELFL ;Select file
S NOBTCH=1
;D SELFL^BAR50FS
K DIC
S DIC="^BAREDI(""I"",DUZ(2),"
S DIC("W")="D VIEWLIST^BAREDP00"
W !
S DIC(0)="AEZQM"
S DIC("A")="Select file: "
;S DIC("S")="I $$NEWFILE^BAREDP00(Y)" ;show only files newer than...12/20/2013 P.OTT TEST
K DD,DO
D ^DIC
I Y'>0 Q
L +^BAREDI("I",+Y):2 E W !,"THIS FILE IS BEING VIEWED, REVIEWED OR POSTED BY ANOTHER USER!! TRY AGAIN LATER." G SELFL ;BAR*1.8*5 SRS-80 TPF
S IMPDA=$P(Y,U)
S TRDA=$P(Y(0),U,3)
S HSTIME=$P(Y(0),U,2)
;RPTLOOK set in REPORT tag - allow rpts on batches > 3quarters old
S HSTFILE=$P(Y(0),U,5)
I '$G(RPTLOOK) D I 'Y G SELFL
. I '$$CKDATE^BARPST(HSTFILE,1,"SELECT ERA FILE") S Y=0 K IMPDA ;MRS;BAR*1.8*6 DD 4.2.4 ;bar*1.8*20
S TRNAME=$$GET1^DIQ(90056.01,TRDA,.01)
I TRNAME'["HIPAA" D
.S BARCOL=$P(Y(0),U,6)
.S BARITM=$P(Y(0),U,7)
.I +BARCOL,+BARITM S NOBTCH=0
K DIC
Q
;
NEWFILE(Y) ;
N X,X1,X2
S X=^BAREDI("I",DUZ(2),Y,0)
S X=$P(X,"_ERA_",2)
S X=$P(X,"^",1) I X="" Q 1
S %DT="" D ^%DT
;W !,X," = ",Y
S X1=DT,X2=Y D ^%DTC I X>365 Q 0 ;W " > 365 DYAS" Q 0
Q 1
SELCK ;
D SELCK^BAREDP0A
Q
;
BTCHCHK ;
D INIT^BARUTL
K BARCOL,BARITM
D BATCH^BARFPST
; Returns BARCOL
I '$G(BARCOL) D Q
.W !,"NO BATCH SELECTED ",!
.H 2
D ITEM^BARFPST
I +$G(BARCOL),+$G(BARITM)
E D Q
.W !,"NONE SELECTED ",!
.H 2
K DIE,DR,DA
S DIE=$$DIC^XBDIQ1(90056.02)
S DA=IMPDA
S DR=".06////^S X=BARCOL;.07////^S X=BARITM"
D ^DIE
S NOBTCH=0
H 2
Q
BTCHDISP ;
S SP=" "
D CLEAR^VALM1
I $G(BARCOL) D ENP^XBDIQ1(90051.01,"BARCOL",".01;8","BNM($J,")
W !,"Transport: ",$P($G(^BAREDI("1T",TRDA,0)),"^")
W !,"Created from ",$G(HSTFILE)," on ",$G(HSTIME)
W !!,"Batch: ",$G(BNM($J,.01))_" "_$G(BNM($J,8))
I $G(BARCOL) D BBAL^BARPST(BARCOL)
W !!,"Item: "_$G(BARITM)
I $G(BARITM) D IBAL^BARPST(BARITM)
Q
CLNUP ;
I $G(IMPDA) L -^BAREDI("I",IMPDA)
K XBDIR,X,Y,HSTFILE,ANS,IMPDA,TRDA,DATM,SEQ,TNAME
K HSTIME,BARCOL,BARITM
Q
VIEWLIST ;EP
N I,BARCHK
W ?35,$P($G(^BAREDI("I",DUZ(2),+Y,0)),U,5)
I $P($G(^BAREDI("I",DUZ(2),+Y,0)),U,9)]"" W !?50,"CHK/EFT #: ",$P(^BAREDI("I",DUZ(2),+Y,0),U,9) Q
S I=""
F S I=$O(^BAREDI("I",DUZ(2),"F",I)) Q:I="" D
. Q:'$D(^BAREDI("I",DUZ(2),"F",I,+Y))
. S BARCHK(I)=""
S I=""
F S I=$O(BARCHK(I)) Q:I="" W ?50,"CHK/EFT #: ",I,!
Q
READ(BARPATH,BARFILE) ; EP
; Read host file into ^TMP($J,"ERA")
N BARCNT,BARTXT,BARDONE
S (BARCNT,BARDONE)=0,BARREC=""
D OPEN^%ZISH("835FILE"_$J,BARPATH,BARFILE,"R")
I POP D Q
. W !!,"Error opening file....please verify filename and directory and try again"
. S BARDONE=1
. D EOP^BARUTL(1)
S BARCNT=0,BARI=0 ;# OF DELIMITERS
F I=1:1 Q:BARCNT=3 D
. U IO READ *CH
. I CH=10 Q
. I CH=13 Q
. S BARI=BARI+1 I BARI=106 S BARDEL=$C(CH),BARCNT=1 ;GET DELIMITER
. S BARREC=BARREC_$C(CH)
. I BARI>106 I BARDEL=$C(CH) S BARCNT=BARCNT+1
D CLOSE^%ZISH("835FILE"_$J)
Q ;EOR
BAREDP00 ; IHS/SD/LSL - AR ERA AUTO-POSTIEG ; 01/30/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,5,6,7,10,17,20,21,23**;OCT 26,2005
+2 ;P23: JAN 2013 P.OTTIS: AUTO-SELECT THE TRANSPORT TYPE ($$FORMAT)
+3 ;
+4 QUIT
TSEL ;EP TRANSPORT SELECT (DEFUNCT)
+1 WRITE !
+2 KILL DIC,DA
+3 SET DIC=$$DIC^XBDIQ1(90056.01)
+4 SET DIC(0)="AEQM"
+5 KILL DD,DO
+6 DO ^DIC
+7 SET TRDA=+Y
+8 SET TRNAME=$PIECE(Y,U,2)
+9 QUIT
+10 ;THIS IS ENTRY POINT FOR BOTH 4010 & 5010 TRANSPORT TYPES
INSTALL ;EP -Load New Import
+1 DO SIG^XUSESIG
+2 IF X1=""
QUIT
+3 IF $GET(DUZ(2))=""
Begin DoDot:1
+4 WRITE !!,"Check your DUZ setup."
+5 HANG 4
End DoDot:1
QUIT
+6 IF '$DATA(^BAREDI("I",DUZ(2),0))
SET ^BAREDI("I",DUZ(2),0)="A/R EDI IMPORT^90056.02^^^"
+7 KILL ^TMP($JOB,"ERA")
+8 SET DIR(0)="F"
+9 SET DIR("A")="Enter the directory path for the transport file"
+10 SET BARPATH=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),0)),U,17)
+11 SET DIR("B")=BARPATH
+12 SET DIR("?")="For example enter '/usr/mydir/'"
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DIRUT)
QUIT
+16 ; Path
+17 SET XBDIR=X
+18 DO FNAME^BAREDIUT
+19 SET HSTFILE=$GET(XBFN)
+20 IF HSTFILE=""
QUIT
+21 WRITE !!,"CHECKING FILE FORMAT....."
+22 SET BARCTRL=0
+23 SET POP=0
DO READ(XBDIR,HSTFILE)
IF POP
QUIT
+24 ;------------------------------>
SET BARRET=$$FORMAT(BARREC)
IF +BARRET
Begin DoDot:1
+25 WRITE !,"The file ",HSTFILE," in directory ",XBDIR
+26 WRITE !,"is not a Remittance Advice. It cannot be loaded."
+27 WRITE !,"Reason: "
+28 IF BARRET=1
WRITE " missing 'ISA' id "
+29 IF BARRET=2
WRITE " missing 'HP' id "
+30 IF BARRET=3
WRITE " UNKNOWN TRANSPORT FILE TYPE."
+31 DO EOP^BARUTL(1)
+32 QUIT
End DoDot:1
QUIT
+33 SET TRNAME=$PIECE(BARRET,"^",2)
+34 SET TRDA=$ORDER(^BAREDI("1T","B",TRNAME,""))
+35 WRITE !,"File type: ",TRNAME," FILE FORMAT OKAY."
+36 ;Read file into ^TMP($J,"ERA")
DO READ^BAR50PA1(XBDIR,HSTFILE)
+37 IF +$GET(POP)
QUIT
+38 IF TRNAME["5010"
DO 5010^BAR50P00
QUIT
+39 DO 4010
QUIT
+40 ;-------------------------------------------------------
QUIT
4010 SET ANS="Y"
+1 ;bar*1.8*20
KILL FILE
+2 IF $DATA(^BAREDI("I",DUZ(2),"C",HSTFILE))
Begin DoDot:1
+3 SET IEN=$ORDER(^BAREDI("I",DUZ(2),"C",HSTFILE,9999999),-1)
+4 SET LOADDT=""
+5 IF (+IEN'=0)
SET LOADDT=$$GET1^DIQ(90056.02,IEN,".02")
SET FILE=$$GET1^DIQ(90056.02,IEN,".01")
+6 WRITE !!,"This file was previously loaded on "_LOADDT_" as",!?2,"file "_FILE
+7 WRITE !!,?5," You can exit and review the import by entering"
+8 WRITE !,?5," the filename in the View Import Header option.",!
+9 WRITE !,"NOTE: reloading a file will create duplicate entries in the A/R EDI Check!"
+10 WRITE !,"Proceed with caution"
+11 SET BARFLG=1
+12 SET BARFLG=$$POSTCHK^BAREDP0A(IEN)
+13 IF BARFLG=1
WRITE !,"Nothing has been posted from this ERA. If you reload it, the original file",!,"will be replaced with this file. Any edits done in REV will be lost."
+14 IF BARFLG=0
Begin DoDot:2
+15 WRITE !!!,"Part of this file has been POSTED and is therefore not eligible for reload."
End DoDot:2
SET ANS="N"
QUIT
+16 SET DIR(0)="Y"
+17 SET DIR("A")="Do you wish to reload this file"
+18 SET DIR("B")="N"
+19 SET DIR("?")="Enter 'Y' to re-install transport file: "
+20 DO ^DIR
+21 IF $DATA(DIRUT)!Y=0
SET ANS="N"
QUIT
+22 IF BARFLG=1
Begin DoDot:2
+23 KILL DIR
+24 SET DIR(0)="Y"
+25 SET DIR("A")="Are you sure?"
+26 SET DIR("B")="N"
+27 SET DIR("?")="Enter 'Y' to re-install transport file: "
+28 DO ^DIR
End DoDot:2
+29 IF BARFLG=1
IF $DATA(DIRUT)!(ANS'="Y")
QUIT
+30 KILL DIR
+31 SET ANS=$SELECT(+Y:"Y",1:"N")
+32 IF ANS'="Y"
QUIT
End DoDot:1
IF ANS="N"
QUIT
+33 IF ANS'="Y"
QUIT
+34 KILL XBY,XBGUI
+35 WRITE !!,"File",?25,"Directory",?50,"Transport"
+36 WRITE !,HSTFILE,?25,XBDIR,?50,TRNAME,!!
+37 SET DIR(0)="Y"
+38 SET DIR("A")="Do you want to proceed"
+39 SET DIR("B")="N"
+40 SET DIR("?")="Enter 'Y' to install transport file: "
+41 DO ^DIR
+42 KILL DIR
+43 IF $DATA(DIRUT)
QUIT
+44 IF '+Y
QUIT
+45 IF +$GET(BARFLG)=1
Begin DoDot:1
+46 SET DIK=$$DIC^XBDIQ1(90056.02)
+47 SET DA=IEN
+48 DO ^DIK
End DoDot:1
+49 SET BARCTRL=0
+50 ;Read file into ^TMP($J,"ERA")
DO READ^BAREDPA1(XBDIR,HSTFILE)
+51 IF +$GET(POP)
QUIT
+52 DO EOP^BARUTL(1)
+53 IF '$DATA(^TMP($JOB,"ERA"))
Begin DoDot:1
+54 WRITE !,"The file ",HSTFILE," in directory ",XBDIR
+55 WRITE !,"Appears to be an empty file."
+56 WRITE !,"Empty files are not HIPAA compliant."
+57 WRITE !,"Inform your source and request a HIPAA compliant file"
+58 WRITE !,"Please contact your supervisor for assistance."
+59 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+60 DO CLEAR^VALM1
+61 SET X=$ORDER(^TMP($JOB,"ERA",""),-1)
+62 WRITE !,"LINE COUNT LOADED: ",X,!
+63 HANG 3
+64 IF X'>0
GOTO INSTALL
+65 KILL DIC
+66 SET DIC=$$DIC^XBDIQ1(90056.02)
+67 SET DIC(0)="EL"
+68 SET X=HSTFILE
+69 ;bar*1.8*20
IF $GET(FILE)
SET DINUM=($PIECE(FILE,"_")-1000)
+70 KILL DD,DO
DO FILE^DICN
+71 SET IMPDA=+Y
+72 KILL DIC
+73 IF +Y<1
Begin DoDot:1
+74 WRITE !!,"File not created for transport"
+75 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+76 DO NOW^%DTC
+77 SET X=X+17000000
+78 SET DATE=$EXTRACT(X,5,6)_"/"_$EXTRACT(X,7,8)_"/"_$EXTRACT(X,1,4)
+79 DO YX^%DTC
+80 SET DATM=Y
+81 SET SEQ=1000+IMPDA
+82 SET TNAME=SEQ_"_ERA_"_DATE
+83 WRITE TNAME,!
HANG 3
+84 KILL DIE,DR,DA
+85 SET DIE=$$DIC^XBDIQ1(90056.02)
+86 SET DA=IMPDA
+87 SET DR=".01///^S X=TNAME"
+88 SET DR=DR_";.04////^S X=XBDIR"
+89 SET DR=DR_";.05////^S X=HSTFILE"
+90 SET DR=DR_";.02////^S X=DATM"
+91 SET DR=DR_";.03////^S X=TRDA"
+92 DO ^DIE
+93 ;Convert ^TMP($J,"ERA") to ^BAREDI("I",DUZ(2))
+94 SET ^BAREDI("I",DUZ(2),IMPDA,10,0)=""
+95 SET BARCNTL=0
+96 IF +BARCTRL
Begin DoDot:1
+97 SET BARESEP=$ASCII(BARESEP)
+98 SET BARSSEP=$ASCII(BARSSEP)
+99 SET BARCSEP=$ASCII(BARCSEP)
End DoDot:1
+100 SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"ERA",X))
IF X=""
QUIT
Begin DoDot:1
+101 SET BARTMP=^TMP($JOB,"ERA",X)
+102 ;Separators=ctrl char
IF +BARCTRL
Begin DoDot:2
+103 FOR I=1:1:$LENGTH(BARTMP)
Begin DoDot:3
+104 IF (($ASCII($EXTRACT(BARTMP,I))<32)!($ASCII($EXTRACT(BARTMP,I))>126))
IF $ASCII(BARTMP,I)=BARSSEP
SET BARTMP=$EXTRACT(BARTMP,1,I-1)_"~"_$EXTRACT(BARTMP,I+1,999)
QUIT
+105 IF (($ASCII($EXTRACT(BARTMP,I))<32)!($ASCII($EXTRACT(BARTMP,I))>126))
IF $ASCII(BARTMP,I)=BARESEP
SET BARTMP=$EXTRACT(BARTMP,1,I-1)_"*"_$EXTRACT(BARTMP,I+1,999)
QUIT
+106 IF (($ASCII($EXTRACT(BARTMP,I))<32)!($ASCII($EXTRACT(BARTMP,I))>126))
IF $ASCII(BARTMP,I)=BARCSEP
SET BARTMP=$EXTRACT(BARTMP,1,I-1)_":"_$EXTRACT(BARTMP,I+1,999)
QUIT
+107 IF ($ASCII($EXTRACT(BARTMP,I))<32)!($ASCII($EXTRACT(BARTMP,I))>126)
SET BARTMP=$EXTRACT(BARTMP,1,I-1)_$EXTRACT(BARTMP,I+1,999)
End DoDot:3
End DoDot:2
+108 IF '+BARCTRL
Begin DoDot:2
+109 FOR I=1:1:$LENGTH(BARTMP)
Begin DoDot:3
+110 IF ($ASCII($EXTRACT(BARTMP,I))<32)!($ASCII($EXTRACT(BARTMP,I))>126)
SET BARTMP=$EXTRACT(BARTMP,1,I-1)_$EXTRACT(BARTMP,I+1,999)
End DoDot:3
End DoDot:2
+111 IF '+$LENGTH(BARTMP)
QUIT
+112 SET BARCNTL=BARCNTL+1
+113 SET ^BAREDI("I",DUZ(2),IMPDA,10,BARCNTL,0)=BARTMP
End DoDot:1
REDO ;EP entry for mid stream testing
+1 SET SUCC=""
+2 SET NRECS=$ORDER(^TMP($JOB,"ERA",""),-1)
+3 IF NRECS=""
SET NRECS="No"
SET SUCC="un"
+4 WRITE !,"The ",XBFN," file has been "_SUCC_"successful in updating"
+5 WRITE !,"the transport global"
+6 WRITE !!,NRECS," records updated"
+7 IF NRECS="No"
QUIT
+8 WRITE !,"PROCESSING",!,"TRANSPORT FILE: ",?20,XBFN
+9 WRITE !,"IMPORT NAME: ",?20,TNAME,!!
+10 ; Split image into segmts
+11 WRITE !,"Starting stage 1 of 3 -> Extract data from transport to segments"
+12 DO EN^BAREDP01(TRDA,IMPDA)
+13 WRITE !,"Stage 1 -> Complete"
+14 ; Parse segmts into elemts & vals
+15 WRITE !!,"Starting stage 2 of 3 -> Parse segments into elements & values"
+16 DO EN^BAREDP02(TRDA,IMPDA)
+17 ;bar*1.8*20 REQ2
DO CHKS^BAREDP02(IMPDA)
+18 WRITE !," Stand by to print TRN - Check Number/Check Amount Report..."
+19 ;bar*1.8*20 REQ2
DO EN1^BAREDPCS
+20 WRITE !,"Stage 2 -> Complete"
+21 ; Build postable clms
+22 WRITE !!,"Starting stage 3 of 3 -> Build postable claims"
+23 HANG 1
+24 DO EN^BAREDP03(TRDA,IMPDA)
+25 WRITE !,"Stage 3 -> Complete"
+26 ;bar*1.8*20
DO EOP^BARUTL(1)
+27 QUIT
PLB ;Chk for PLB/Pymt Reversals ;MRS:BAR*1.8*10 D159
+1 ;start new bar*1.8*20 REQ4
+2 DO SELFL
+3 IF Y'>0
QUIT
+4 ;IHS/SD/TPF 8/22/2001 BAR*1.8*21 5010
+5 IF TRNAME[("5010")
DO PLB^BAR50P00
QUIT
+6 SET BARCNT=0
SET I=0
+7 FOR
SET I=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,I))
IF 'I
QUIT
Begin DoDot:1
+8 SET BARCNT=BARCNT+1
End DoDot:1
+9 IF BARCNT=1
SET BARCKIEN=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,0))
SET BARCHK=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)
+10 ;if 1+ chk, pick 1
IF BARCNT>1
DO SELCK
+11 IF +$GET(BARCKIEN)'>0
QUIT
+12 SET BARQT=0
SET BARQUIT=1
+13 IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M"))
Begin DoDot:1
+14 SET CLMDA=0
+15 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M",CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:2
+16 IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)=BARCHK
SET BARQT=1
End DoDot:2
IF BARQT
QUIT
+17 IF 'BARQT
QUIT
+18 WRITE !!,"Bill matching for this check has already been done."
+19 KILL DIR
+20 SET DIR(0)="Y"
+21 SET DIR("A")="Do you want to do matching again"
+22 DO ^DIR
KILL DIR
+23 SET BARQUIT=+Y
End DoDot:1
+24 IF 'BARQUIT
QUIT
+25 IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U,7)=""
WRITE !!,"NOTE: This check has NOT been matched to a batch/item",!
+26 WRITE !,"I will begin bill matching..."
+27 HANG 1
+28 DO EN^BAREDP04(TRDA,IMPDA)
+29 IF '+$GET(QFLG)
WRITE !!,"Matching complete"
+30 IF +$GET(QFLG)
WRITE !!,"Matching NOT complete"
+31 SET DIE=$$DIC^XBDIQ1(90056.02)
+32 SET DA=IMPDA
+33 SET DR=".08////M"
+34 DO ^DIE
+35 KILL DIR
+36 SET DIR(0)="E"
+37 SET DIR("A")="<CR> - Continue"
+38 DO ^DIR
+39 DO CLEAR^VALM1
+40 DO CLNUP
+41 QUIT
FORMAT(BARREC) ;
+1 ; Verify file loading is HIPAA 835 if Transport HIPAA 835
+2 ; Return >0^STRING if wrong format
+3 ; Return 0^TRANSPORT_TYPE if correct format
+4 KILL BARSSEP,BARESEP,BARCSEP
+5 NEW BARTMP,BARGS08,X,I,BARERR
+6 SET BARCTRL=0
SET BARERR=0
+7 SET BARTMP=BARREC
+8 ;all X12 messages start w/ ISA
IF $EXTRACT(BARTMP,1,3)'="ISA"
SET BARERR=1
QUIT BARERR
+9 ;Element separator
SET BARESEP=$EXTRACT(BARTMP,4)
+10 IF $ASCII(BARESEP)<32!($ASCII(BARESEP)>126)
SET BARCTRL=1
+11 ;Segment separator
SET BARSSEP=$EXTRACT(BARTMP,106)
+12 IF $ASCII(BARSSEP)<32!($ASCII(BARSSEP)>126)
SET BARCTRL=1
+13 ;Component separator
SET BARCSEP=$EXTRACT(BARTMP,105)
+14 IF $ASCII(BARCSEP)<32!($ASCII(BARCSEP)>126)
SET BARCTRL=1
+15 IF DUZ=902
WRITE 1/0
+16 ;GS01 must be HP for 835
IF $EXTRACT($PIECE(BARTMP,BARSSEP,2),4,5)'="HP"
SET BARERR=2
QUIT BARERR
+17 SET BARGS08=$PIECE($PIECE(BARTMP,BARSSEP,2),BARESEP,9)
+18 IF BARGS08["004010X091"
QUIT 0_"^HIPAA 835 v4010"
+19 IF BARGS08["005010X221"
QUIT 0_"^HIPAA 835 v5010"
+20 QUIT 3_"^"_BARGS08
+21 ;
REVIEW ;EP
+1 IF $GET(DUZ(2))=""
Begin DoDot:1
+2 WRITE !!,"Check your DUZ setup."
+3 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+4 DO SELFL
+5 IF Y'>0
QUIT
+6 IF TRNAME[("5010")
DO REVIEW^BAR50P00
QUIT
+7 DO ERACHECK^BAREDP09
+8 IF $ORDER(BARCHK(9999),-1)=1
SET BARCKIEN=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,0))
SET BARCHK=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)
+9 IF $ORDER(BARCHK(9999),-1)>1
DO SELCK
+10 IF +$GET(BARCKIEN)'>0
QUIT
+11 ;Review screen
+12 DO EN^BAREDP05
+13 ;Mark chk as reviewed
IF TRNAME["HIPAA"
Begin DoDot:1
+14 DO NOW^%DTC
+15 SET BARDTREV=%
+16 KILL DIE,DIC,DA,DR,X,Y
+17 SET DIE="^BARECHK("
+18 SET DA=$PIECE(BARCHK(BARCKIEN),U,5)
+19 SET DR=".05///^S X=BARDTREV"
+20 SET DR=DR_";.06////^S X=DUZ"
+21 DO ^DIE
End DoDot:1
+22 DO CLNUP
+23 QUIT
POST ; EP
+1 IF $GET(DUZ(2))=""
Begin DoDot:1
+2 WRITE !!,"Check your DUZ setup."
+3 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+4 DO SELFL
+5 IF Y'>0
QUIT
+6 IF TRNAME[("5010")
DO POST^BAR50P00
QUIT
+7 IF TRNAME["HIPAA"
Begin DoDot:1
+8 SET BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"POST")
+9 IF '+BARCKIEN
QUIT
+10 DO POST^BAREDP08(BARCKIEN)
End DoDot:1
QUIT
+11 ;Get batch/item info
+12 IF NOBTCH
DO BTCHCHK
+13 IF 'NOBTCH
Begin DoDot:1
+14 DO BTCHDISP
+15 WRITE !
+16 SET DIR(0)="Y"
+17 SET DIR("A")="Do you want to select a different batch"
+18 SET DIR("B")="N"
+19 SET DIR("?")="Enter 'Y' to select a different batch "
+20 DO ^DIR
+21 KILL DIR
+22 IF $DATA(DIRUT)
QUIT
+23 SET NOBTCH=1
+24 IF X="Y"
DO BTCHCHK
End DoDot:1
+25 DO CLEAR^VALM1
+26 IF 'NOBTCH
DO BTCHDISP
+27 IF +$GET(BARCOL)
IF +$GET(BARITM)
+28 IF '$TEST
Begin DoDot:1
+29 WRITE !,"Batch & Item not selected ",!,"Adjustments only will be made,",!!
+30 HANG 2
+31 KILL BARCOL,BARITM
+32 KILL DR,DIE,DA,DIC
+33 SET DIE=$$DIC^XBDIQ1(90056.02)
+34 SET DA=IMPDA
+35 SET DR=".06///@;.07///@"
+36 DO ^DIE
End DoDot:1
POSTA ;EP POST
+1 WRITE !
+2 SET DIR(0)="Y"
+3 SET DIR("A")="DO YOU WANT TO POST CLAIMS NOW."
+4 SET DIR("A",1)="The above information details the transport and batch that"
+5 SET DIR("A",2)="has been selected to post matched claims to the A/R database"
+6 SET DIR("B")="N"
+7 SET DIR("?")="Enter 'Y' to load matched claims: "
+8 DO ^DIR
+9 KILL DIR
+10 IF $DATA(DIRUT)
QUIT
+11 IF X="Y"
Begin DoDot:1
+12 DO EN^BAREDP06(TRDA,IMPDA)
+13 ;"Roll-over as you go" flag set to no
SET BARRAYGO=0
+14 ;Loops BARROLL array & marks for rollback
DO EN^BARROLL
+15 KILL BARROLL
End DoDot:1
+16 DO CLNUP
+17 QUIT
VIEW ; EP
+1 IF $GET(DUZ(2))=""
Begin DoDot:1
+2 WRITE !!,"Check your DUZ setup."
+3 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+4 NEW RPTLOOK
SET RPTLOOK=1
+5 DO SELFL
+6 IF Y'>0
QUIT
+7 IF TRNAME[("5010")
DO VIEW^BAR50P00
QUIT
+8 DO VIEW^BAREDIUT(TRDA,IMPDA)
+9 DO CLNUP
+10 QUIT
REPORT ; EP
+1 IF $GET(DUZ(2))=""
Begin DoDot:1
+2 WRITE !!,"Check your DUZ setup."
+3 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+4 ;Allow rpts to view ERA batches older than 3rd qtr past
NEW RPTLOOK
SET RPTLOOK=1
+5 ;RPTLOOK will be used to BARPST to bypass chk HEAT10729 BAR*1.8*17 PKD 3/30/10
+6 DO SELFL
+7 IF Y'>0
QUIT
+8 IF TRNAME[("5010")
DO REPORT^BAR50P00
QUIT
+9 IF TRNAME["HIPAA"
Begin DoDot:1
+10 SET BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"REPORT")
End DoDot:1
IF '+BARCKIEN
QUIT
SET BARCHK=$$GET1^DIQ(90056.22,BARCKIEN,.01)
+11 IF TRNAME["HIPAA"
IF +BARCKIEN
DO EN^BAREDP10
+12 IF TRNAME'["HIPAA"
DO EN^BAREDP07
+13 DO CLNUP
+14 QUIT
+15 ;new code bar*1.8*20 REQ8
NFOUND ; EP
+1 IF $GET(DUZ(2))=""
Begin DoDot:1
+2 WRITE !!,"Check your DUZ setup."
+3 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+4 ;Allow rpts to view ERA batches older than 3rd qtr past
NEW RPTLOOK
SET RPTLOOK=1
+5 DO SELFL
+6 IF Y'>0
QUIT
+7 IF TRNAME[("5010")
DO NFOUND^BAR50P00
QUIT
+8 IF TRNAME["HIPAA"
DO EN^BAREDP12
+9 DO CLNUP
+10 QUIT
SELFL ;Select file
+1 SET NOBTCH=1
+2 ;D SELFL^BAR50FS
+3 KILL DIC
+4 SET DIC="^BAREDI(""I"",DUZ(2),"
+5 SET DIC("W")="D VIEWLIST^BAREDP00"
+6 WRITE !
+7 SET DIC(0)="AEZQM"
+8 SET DIC("A")="Select file: "
+9 ;S DIC("S")="I $$NEWFILE^BAREDP00(Y)" ;show only files newer than...12/20/2013 P.OTT TEST
+10 KILL DD,DO
+11 DO ^DIC
+12 IF Y'>0
QUIT
+13 ;BAR*1.8*5 SRS-80 TPF
LOCK +^BAREDI("I",+Y):2
IF '$TEST
WRITE !,"THIS FILE IS BEING VIEWED, REVIEWED OR POSTED BY ANOTHER USER!! TRY AGAIN LATER."
GOTO SELFL
+14 SET IMPDA=$PIECE(Y,U)
+15 SET TRDA=$PIECE(Y(0),U,3)
+16 SET HSTIME=$PIECE(Y(0),U,2)
+17 ;RPTLOOK set in REPORT tag - allow rpts on batches > 3quarters old
+18 SET HSTFILE=$PIECE(Y(0),U,5)
+19 IF '$GET(RPTLOOK)
Begin DoDot:1
+20 ;MRS;BAR*1.8*6 DD 4.2.4 ;bar*1.8*20
IF '$$CKDATE^BARPST(HSTFILE,1,"SELECT ERA FILE")
SET Y=0
KILL IMPDA
End DoDot:1
IF 'Y
GOTO SELFL
+21 SET TRNAME=$$GET1^DIQ(90056.01,TRDA,.01)
+22 IF TRNAME'["HIPAA"
Begin DoDot:1
+23 SET BARCOL=$PIECE(Y(0),U,6)
+24 SET BARITM=$PIECE(Y(0),U,7)
+25 IF +BARCOL
IF +BARITM
SET NOBTCH=0
End DoDot:1
+26 KILL DIC
+27 QUIT
+28 ;
NEWFILE(Y) ;
+1 NEW X,X1,X2
+2 SET X=^BAREDI("I",DUZ(2),Y,0)
+3 SET X=$PIECE(X,"_ERA_",2)
+4 SET X=$PIECE(X,"^",1)
IF X=""
QUIT 1
+5 SET %DT=""
DO ^%DT
+6 ;W !,X," = ",Y
+7 ;W " > 365 DYAS" Q 0
SET X1=DT
SET X2=Y
DO ^%DTC
IF X>365
QUIT 0
+8 QUIT 1
SELCK ;
+1 DO SELCK^BAREDP0A
+2 QUIT
+3 ;
BTCHCHK ;
+1 DO INIT^BARUTL
+2 KILL BARCOL,BARITM
+3 DO BATCH^BARFPST
+4 ; Returns BARCOL
+5 IF '$GET(BARCOL)
Begin DoDot:1
+6 WRITE !,"NO BATCH SELECTED ",!
+7 HANG 2
End DoDot:1
QUIT
+8 DO ITEM^BARFPST
+9 IF +$GET(BARCOL)
IF +$GET(BARITM)
+10 IF '$TEST
Begin DoDot:1
+11 WRITE !,"NONE SELECTED ",!
+12 HANG 2
End DoDot:1
QUIT
+13 KILL DIE,DR,DA
+14 SET DIE=$$DIC^XBDIQ1(90056.02)
+15 SET DA=IMPDA
+16 SET DR=".06////^S X=BARCOL;.07////^S X=BARITM"
+17 DO ^DIE
+18 SET NOBTCH=0
+19 HANG 2
+20 QUIT
BTCHDISP ;
+1 SET SP=" "
+2 DO CLEAR^VALM1
+3 IF $GET(BARCOL)
DO ENP^XBDIQ1(90051.01,"BARCOL",".01;8","BNM($J,")
+4 WRITE !,"Transport: ",$PIECE($GET(^BAREDI("1T",TRDA,0)),"^")
+5 WRITE !,"Created from ",$GET(HSTFILE)," on ",$GET(HSTIME)
+6 WRITE !!,"Batch: ",$GET(BNM($JOB,.01))_" "_$GET(BNM($JOB,8))
+7 IF $GET(BARCOL)
DO BBAL^BARPST(BARCOL)
+8 WRITE !!,"Item: "_$GET(BARITM)
+9 IF $GET(BARITM)
DO IBAL^BARPST(BARITM)
+10 QUIT
CLNUP ;
+1 IF $GET(IMPDA)
LOCK -^BAREDI("I",IMPDA)
+2 KILL XBDIR,X,Y,HSTFILE,ANS,IMPDA,TRDA,DATM,SEQ,TNAME
+3 KILL HSTIME,BARCOL,BARITM
+4 QUIT
VIEWLIST ;EP
+1 NEW I,BARCHK
+2 WRITE ?35,$PIECE($GET(^BAREDI("I",DUZ(2),+Y,0)),U,5)
+3 IF $PIECE($GET(^BAREDI("I",DUZ(2),+Y,0)),U,9)]""
WRITE !?50,"CHK/EFT #: ",$PIECE(^BAREDI("I",DUZ(2),+Y,0),U,9)
QUIT
+4 SET I=""
+5 FOR
SET I=$ORDER(^BAREDI("I",DUZ(2),"F",I))
IF I=""
QUIT
Begin DoDot:1
+6 IF '$DATA(^BAREDI("I",DUZ(2),"F",I,+Y))
QUIT
+7 SET BARCHK(I)=""
End DoDot:1
+8 SET I=""
+9 FOR
SET I=$ORDER(BARCHK(I))
IF I=""
QUIT
WRITE ?50,"CHK/EFT #: ",I,!
+10 QUIT
READ(BARPATH,BARFILE) ; EP
+1 ; Read host file into ^TMP($J,"ERA")
+2 NEW BARCNT,BARTXT,BARDONE
+3 SET (BARCNT,BARDONE)=0
SET BARREC=""
+4 DO OPEN^%ZISH("835FILE"_$JOB,BARPATH,BARFILE,"R")
+5 IF POP
Begin DoDot:1
+6 WRITE !!,"Error opening file....please verify filename and directory and try again"
+7 SET BARDONE=1
+8 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+9 ;# OF DELIMITERS
SET BARCNT=0
SET BARI=0
+10 FOR I=1:1
IF BARCNT=3
QUIT
Begin DoDot:1
+11 USE IO
READ *CH
+12 IF CH=10
QUIT
+13 IF CH=13
QUIT
+14 ;GET DELIMITER
SET BARI=BARI+1
IF BARI=106
SET BARDEL=$CHAR(CH)
SET BARCNT=1
+15 SET BARREC=BARREC_$CHAR(CH)
+16 IF BARI>106
IF BARDEL=$CHAR(CH)
SET BARCNT=BARCNT+1
End DoDot:1
+17 DO CLOSE^%ZISH("835FILE"_$JOB)
+18 ;EOR
QUIT
