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

BAREDP00.m

Go to the documentation of this file. 
  1. 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
  1.  ;P23: JAN 2013 P.OTTIS: AUTO-SELECT THE TRANSPORT TYPE ($$FORMAT)
  1.  ;
  1.  Q
  1. TSEL ;EP TRANSPORT SELECT (DEFUNCT)
  1.  W !
  1.  K DIC,DA
  1.  S DIC=$$DIC^XBDIQ1(90056.01)
  1.  S DIC(0)="AEQM"
  1.  K DD,DO
  1.  D ^DIC
  1.  S TRDA=+Y
  1.  S TRNAME=$P(Y,U,2)
  1.  Q
  1.  ;THIS IS ENTRY POINT FOR BOTH 4010 & 5010 TRANSPORT TYPES
  1. INSTALL ;EP -Load New Import 
  1.  D SIG^XUSESIG
  1.  Q:X1=""
  1.  I $G(DUZ(2))="" D  Q
  1.  . W !!,"Check your DUZ setup."
  1.  . H 4
  1.  I '$D(^BAREDI("I",DUZ(2),0)) S ^BAREDI("I",DUZ(2),0)="A/R EDI IMPORT^90056.02^^^"
  1.  K ^TMP($J,"ERA")
  1.  S DIR(0)="F"
  1.  S DIR("A")="Enter the directory path for the transport file"
  1.  S BARPATH=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),0)),U,17)
  1.  S DIR("B")=BARPATH
  1.  S DIR("?")="For example enter '/usr/mydir/'"
  1.  D ^DIR
  1.  K DIR
  1.  Q:$D(DIRUT)
  1.  ; Path
  1.  S XBDIR=X
  1.  D FNAME^BAREDIUT
  1.  S HSTFILE=$G(XBFN)
  1.  Q:HSTFILE=""
  1.  W !!,"CHECKING FILE FORMAT....."
  1.  S BARCTRL=0
  1.  S POP=0 D READ(XBDIR,HSTFILE) I POP QUIT
  1.  S BARRET=$$FORMAT(BARREC) I +BARRET D  QUIT  ;------------------------------>
  1.  . W !,"The file ",HSTFILE," in directory ",XBDIR
  1.  . W !,"is not a Remittance Advice.  It cannot be loaded."
  1.  . W !,"Reason: "
  1.  . I BARRET=1 W " missing 'ISA' id "
  1.  . I BARRET=2 W " missing 'HP' id "
  1.  . I BARRET=3 W " UNKNOWN TRANSPORT FILE TYPE."
  1.  . D EOP^BARUTL(1)
  1.  . Q
  1.  S TRNAME=$P(BARRET,"^",2)
  1.  S TRDA=$O(^BAREDI("1T","B",TRNAME,""))
  1.  W !,"File type: ",TRNAME," FILE FORMAT OKAY."
  1.  D READ^BAR50PA1(XBDIR,HSTFILE)  ;Read file into ^TMP($J,"ERA")
  1.  Q:+$G(POP)
  1.  I TRNAME["5010" D 5010^BAR50P00 Q
  1.  D 4010 Q
  1.  Q  ;-------------------------------------------------------
  1. 4010 S ANS="Y"
  1.  K FILE  ;bar*1.8*20
  1.  I $D(^BAREDI("I",DUZ(2),"C",HSTFILE)) D  Q:ANS="N"
  1.  . S IEN=$O(^BAREDI("I",DUZ(2),"C",HSTFILE,9999999),-1)
  1.  . S LOADDT=""
  1.  . S:(+IEN'=0) LOADDT=$$GET1^DIQ(90056.02,IEN,".02"),FILE=$$GET1^DIQ(90056.02,IEN,".01")
  1.  . W !!,"This file was previously loaded on "_LOADDT_" as",!?2,"file "_FILE
  1.  . W !!,?5," You can exit and review the import by entering"
  1.  . W !,?5," the filename in the View Import Header option.",!
  1.  . W !,"NOTE: reloading a file will create duplicate entries in the A/R EDI Check!"
  1.  . W !,"Proceed with caution"
  1.  . S BARFLG=1
  1.  . S BARFLG=$$POSTCHK^BAREDP0A(IEN)
  1.  . 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."
  1.  . I BARFLG=0 D  S ANS="N" Q
  1.  . . W !!!,"Part of this file has been POSTED and is therefore not eligible for reload."
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="Do you wish to reload this file"
  1.  . S DIR("B")="N"
  1.  . S DIR("?")="Enter 'Y' to re-install transport file: "
  1.  . D ^DIR
  1.  . I $D(DIRUT)!Y=0 S ANS="N" Q
  1.  . I BARFLG=1 D
  1.  . . K DIR
  1.  . . S DIR(0)="Y"
  1.  . . S DIR("A")="Are you sure?"
  1.  . . S DIR("B")="N"
  1.  . . S DIR("?")="Enter 'Y' to re-install transport file: "
  1.  . . D ^DIR
  1.  . I BARFLG=1 Q:$D(DIRUT)!(ANS'="Y")
  1.  . K DIR
  1.  . S ANS=$S(+Y:"Y",1:"N")
  1.  . Q:ANS'="Y"
  1.  Q:ANS'="Y"
  1.  K XBY,XBGUI
  1.  W !!,"File",?25,"Directory",?50,"Transport"
  1.  W !,HSTFILE,?25,XBDIR,?50,TRNAME,!!
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you want to proceed"
  1.  S DIR("B")="N"
  1.  S DIR("?")="Enter 'Y' to install transport file: "
  1.  D ^DIR
  1.  K DIR
  1.  Q:$D(DIRUT)
  1.  Q:'+Y
  1.   I +$G(BARFLG)=1 D
  1.  . S DIK=$$DIC^XBDIQ1(90056.02)
  1.  . S DA=IEN
  1.  . D ^DIK
  1.  S BARCTRL=0
  1.  D READ^BAREDPA1(XBDIR,HSTFILE)  ;Read file into ^TMP($J,"ERA")
  1.  Q:+$G(POP)
  1.  D EOP^BARUTL(1)
  1.  I '$D(^TMP($J,"ERA")) D  Q
  1.  . W !,"The file ",HSTFILE," in directory ",XBDIR
  1.  . W !,"Appears to be an empty file."
  1.  . W !,"Empty files are not HIPAA compliant."
  1.  . W !,"Inform your source and request a HIPAA compliant file"
  1.  . W !,"Please contact your supervisor for assistance."
  1.  . D EOP^BARUTL(1)
  1.  D CLEAR^VALM1
  1.  S X=$O(^TMP($J,"ERA",""),-1)
  1.  W !,"LINE COUNT LOADED: ",X,!
  1.  H 3
  1.  I X'>0 G INSTALL
  1.  K DIC
  1.  S DIC=$$DIC^XBDIQ1(90056.02)
  1.  S DIC(0)="EL"
  1.  S X=HSTFILE
  1.  S:$G(FILE) DINUM=($P(FILE,"_")-1000)  ;bar*1.8*20
  1.  K DD,DO D FILE^DICN
  1.  S IMPDA=+Y
  1.  K DIC
  1.  I +Y<1 D  Q
  1.  . W !!,"File not created for transport"
  1.  . D EOP^BARUTL(1)
  1.  D NOW^%DTC
  1.  S X=X+17000000
  1.  S DATE=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
  1.  D YX^%DTC
  1.  S DATM=Y
  1.  S SEQ=1000+IMPDA
  1.  S TNAME=SEQ_"_ERA_"_DATE
  1.  W TNAME,! H 3
  1.  K DIE,DR,DA
  1.  S DIE=$$DIC^XBDIQ1(90056.02)
  1.  S DA=IMPDA
  1.  S DR=".01///^S X=TNAME"
  1.  S DR=DR_";.04////^S X=XBDIR"
  1.  S DR=DR_";.05////^S X=HSTFILE"
  1.  S DR=DR_";.02////^S X=DATM"
  1.  S DR=DR_";.03////^S X=TRDA"
  1.  D ^DIE
  1.  ;Convert ^TMP($J,"ERA") to ^BAREDI("I",DUZ(2))
  1.  S ^BAREDI("I",DUZ(2),IMPDA,10,0)=""
  1.  S BARCNTL=0
  1.  I +BARCTRL D
  1.  . S BARESEP=$A(BARESEP)
  1.  . S BARSSEP=$A(BARSSEP)
  1.  . S BARCSEP=$A(BARCSEP)
  1.  S X="" F  S X=$O(^TMP($J,"ERA",X)) Q:X=""  D
  1.  . S BARTMP=^TMP($J,"ERA",X)
  1.  . I +BARCTRL D  ;Separators=ctrl char
  1.  . . F I=1:1:$L(BARTMP) D
  1.  . . .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
  1.  . . .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
  1.  . . .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
  1.  . . .I ($A($E(BARTMP,I))<32)!($A($E(BARTMP,I))>126) S BARTMP=$E(BARTMP,1,I-1)_$E(BARTMP,I+1,999)
  1.  . I '+BARCTRL D
  1.  . . F I=1:1:$L(BARTMP) D
  1.  . . . I ($A($E(BARTMP,I))<32)!($A($E(BARTMP,I))>126) S BARTMP=$E(BARTMP,1,I-1)_$E(BARTMP,I+1,999)
  1.  . I '+$L(BARTMP) Q
  1.  . S BARCNTL=BARCNTL+1
  1.  . S ^BAREDI("I",DUZ(2),IMPDA,10,BARCNTL,0)=BARTMP
  1. REDO ;EP entry for mid stream testing
  1.  S SUCC=""
  1.  S NRECS=$O(^TMP($J,"ERA",""),-1)
  1.  I NRECS="" S NRECS="No",SUCC="un"
  1.  W !,"The ",XBFN," file has been "_SUCC_"successful in updating"
  1.  W !,"the transport global"
  1.  W !!,NRECS," records updated"
  1.  Q:NRECS="No"
  1.  W !,"PROCESSING",!,"TRANSPORT FILE: ",?20,XBFN
  1.  W !,"IMPORT NAME: ",?20,TNAME,!!
  1.  ; Split image into segmts
  1.  W !,"Starting stage 1 of 3 -> Extract data from transport to segments"
  1.  D EN^BAREDP01(TRDA,IMPDA)
  1.  W !,"Stage 1 -> Complete"
  1.  ; Parse segmts into elemts & vals
  1.  W !!,"Starting stage 2 of 3 -> Parse segments into elements & values"
  1.  D EN^BAREDP02(TRDA,IMPDA)
  1.  D CHKS^BAREDP02(IMPDA)  ;bar*1.8*20 REQ2
  1.  W !," Stand by to print TRN - Check Number/Check Amount Report..."
  1.  D EN1^BAREDPCS  ;bar*1.8*20 REQ2
  1.  W !,"Stage 2 -> Complete"
  1.  ; Build postable clms
  1.  W !!,"Starting stage 3 of 3 -> Build postable claims"
  1.  H 1
  1.  D EN^BAREDP03(TRDA,IMPDA)
  1.  W !,"Stage 3 -> Complete"
  1.  D EOP^BARUTL(1)  ;bar*1.8*20
  1.  Q
  1. PLB ;Chk for PLB/Pymt Reversals ;MRS:BAR*1.8*10 D159
  1.  ;start new bar*1.8*20 REQ4
  1.  D SELFL
  1.  I Y'>0 Q
  1.  ;IHS/SD/TPF 8/22/2001 BAR*1.8*21 5010
  1.  I TRNAME[("5010") D PLB^BAR50P00 Q
  1.  S BARCNT=0,I=0
  1.  F  S I=$O(^BAREDI("I",DUZ(2),IMPDA,5,I)) Q:'I  D
  1.  . S BARCNT=BARCNT+1
  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)
  1.  I BARCNT>1 D SELCK  ;if 1+ chk, pick 1
  1.  I +$G(BARCKIEN)'>0 Q
  1.  S BARQT=0,BARQUIT=1
  1.  I $D(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M")) D
  1.  . S CLMDA=0
  1.  . F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M",CLMDA)) Q:'CLMDA  D  Q:BARQT
  1.  . .I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)=BARCHK S BARQT=1
  1.  . Q:'BARQT
  1.  . W !!,"Bill matching for this check has already been done."
  1.  . K DIR
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="Do you want to do matching again"
  1.  . D ^DIR K DIR
  1.  . S BARQUIT=+Y
  1.  Q:'BARQUIT
  1.  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",!
  1.  W !,"I will begin bill matching..."
  1.  H 1
  1.  D EN^BAREDP04(TRDA,IMPDA)
  1.  I '+$G(QFLG) W !!,"Matching complete"
  1.  I +$G(QFLG) W !!,"Matching NOT complete"
  1.  S DIE=$$DIC^XBDIQ1(90056.02)
  1.  S DA=IMPDA
  1.  S DR=".08////M"
  1.  D ^DIE
  1.  K DIR
  1.  S DIR(0)="E"
  1.  S DIR("A")="<CR> - Continue"
  1.  D ^DIR
  1.  D CLEAR^VALM1
  1.  D CLNUP
  1.  Q
  1. FORMAT(BARREC) ;
  1.  ; Verify file loading is HIPAA 835 if Transport HIPAA 835
  1.  ; Return >0^STRING if wrong format
  1.  ; Return 0^TRANSPORT_TYPE if correct format
  1.  K BARSSEP,BARESEP,BARCSEP
  1.  N BARTMP,BARGS08,X,I,BARERR
  1.  S BARCTRL=0,BARERR=0
  1.  S BARTMP=BARREC
  1.  I $E(BARTMP,1,3)'="ISA" S BARERR=1 Q BARERR  ;all X12 messages start w/ ISA
  1.  S BARESEP=$E(BARTMP,4)  ;Element separator
  1.  I $A(BARESEP)<32!($A(BARESEP)>126) S BARCTRL=1
  1.  S BARSSEP=$E(BARTMP,106)  ;Segment separator
  1.  I $A(BARSSEP)<32!($A(BARSSEP)>126) S BARCTRL=1
  1.  S BARCSEP=$E(BARTMP,105)  ;Component separator
  1.  I $A(BARCSEP)<32!($A(BARCSEP)>126) S BARCTRL=1
  1.  I DUZ=902 W 1/0
  1.  I $E($P(BARTMP,BARSSEP,2),4,5)'="HP" S BARERR=2 Q BARERR ;GS01 must be HP for 835
  1.  S BARGS08=$P($P(BARTMP,BARSSEP,2),BARESEP,9)
  1.  I BARGS08["004010X091" Q 0_"^HIPAA 835 v4010"
  1.  I BARGS08["005010X221" Q 0_"^HIPAA 835 v5010"
  1.  Q 3_"^"_BARGS08
  1.  ;
  1. REVIEW ;EP
  1.  I $G(DUZ(2))="" D  Q
  1.  . W !!,"Check your DUZ setup."
  1.  . D EOP^BARUTL(1)
  1.  D SELFL
  1.  I Y'>0 Q
  1.  I TRNAME[("5010") D REVIEW^BAR50P00 Q
  1.  D ERACHECK^BAREDP09
  1.  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)
  1.  I $O(BARCHK(9999),-1)>1 D SELCK
  1.  I +$G(BARCKIEN)'>0 Q
  1.  ;Review screen
  1.  D EN^BAREDP05
  1.  I TRNAME["HIPAA" D  ;Mark chk as reviewed
  1.  .D NOW^%DTC
  1.  .S BARDTREV=%
  1.  .K DIE,DIC,DA,DR,X,Y
  1.  .S DIE="^BARECHK("
  1.  .S DA=$P(BARCHK(BARCKIEN),U,5)
  1.  .S DR=".05///^S X=BARDTREV"
  1.  .S DR=DR_";.06////^S X=DUZ"
  1.  .D ^DIE
  1.  D CLNUP
  1.  Q
  1. POST ; EP
  1.  I $G(DUZ(2))="" D  Q
  1.  .W !!,"Check your DUZ setup."
  1.  .D EOP^BARUTL(1)
  1.  D SELFL
  1.  I Y'>0 Q
  1.  I TRNAME[("5010") D POST^BAR50P00 Q
  1.  I TRNAME["HIPAA" D  Q
  1.  .S BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"POST")
  1.  .Q:'+BARCKIEN
  1.  .D POST^BAREDP08(BARCKIEN)
  1.  ;Get batch/item info
  1.  I NOBTCH D BTCHCHK
  1.  I 'NOBTCH D
  1.  .D BTCHDISP
  1.  .W !
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Do you want to select a different batch"
  1.  .S DIR("B")="N"
  1.  .S DIR("?")="Enter 'Y' to select a different batch "
  1.  .D ^DIR
  1.  .K DIR
  1.  .Q:$D(DIRUT)
  1.  .S NOBTCH=1
  1.  .I X="Y" D BTCHCHK
  1.  D CLEAR^VALM1
  1.  I 'NOBTCH D BTCHDISP
  1.  I +$G(BARCOL),+$G(BARITM)
  1.  E  D
  1.  .W !,"Batch & Item not selected ",!,"Adjustments only will be made,",!!
  1.  .H 2
  1.  .K BARCOL,BARITM
  1.  .K DR,DIE,DA,DIC
  1.  .S DIE=$$DIC^XBDIQ1(90056.02)
  1.  .S DA=IMPDA
  1.  .S DR=".06///@;.07///@"
  1.  .D ^DIE
  1. POSTA ;EP  POST
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="DO YOU WANT TO POST CLAIMS NOW."
  1.  S DIR("A",1)="The above information details the transport and batch that"
  1.  S DIR("A",2)="has been selected to post matched claims to the A/R database"
  1.  S DIR("B")="N"
  1.  S DIR("?")="Enter 'Y' to load matched claims: "
  1.  D ^DIR
  1.  K DIR
  1.  Q:$D(DIRUT)
  1.  I X="Y" D
  1.  .D EN^BAREDP06(TRDA,IMPDA)
  1.  .S BARRAYGO=0  ;"Roll-over as you go" flag set to no
  1.  .D EN^BARROLL  ;Loops BARROLL array & marks for rollback
  1.  .K BARROLL
  1.  D CLNUP
  1.  Q
  1. VIEW ; EP
  1.  I $G(DUZ(2))="" D  Q
  1.  .W !!,"Check your DUZ setup."
  1.  .D EOP^BARUTL(1)
  1.  N RPTLOOK S RPTLOOK=1
  1.  D SELFL
  1.  I Y'>0 Q
  1.  I TRNAME[("5010") D VIEW^BAR50P00 Q
  1.  D VIEW^BAREDIUT(TRDA,IMPDA)
  1.  D CLNUP
  1.  Q
  1. REPORT ; EP
  1.  I $G(DUZ(2))="" D  Q
  1.  .W !!,"Check your DUZ setup."
  1.  .D EOP^BARUTL(1)
  1.  N RPTLOOK S RPTLOOK=1  ;Allow rpts to view ERA batches older than 3rd qtr past
  1.  ;RPTLOOK will be used to BARPST to bypass chk HEAT10729 BAR*1.8*17 PKD 3/30/10
  1.  D SELFL
  1.  I Y'>0 Q
  1.  I TRNAME[("5010") D REPORT^BAR50P00 Q
  1.  I TRNAME["HIPAA" D  Q:'+BARCKIEN  S BARCHK=$$GET1^DIQ(90056.22,BARCKIEN,.01)
  1.  .S BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"REPORT")
  1.  I TRNAME["HIPAA",+BARCKIEN D EN^BAREDP10
  1.  I TRNAME'["HIPAA" D EN^BAREDP07
  1.  D CLNUP
  1.  Q
  1.  ;new code bar*1.8*20 REQ8
  1. NFOUND ; EP
  1.  I $G(DUZ(2))="" D  Q
  1.  .W !!,"Check your DUZ setup."
  1.  .D EOP^BARUTL(1)
  1.  N RPTLOOK S RPTLOOK=1  ;Allow rpts to view ERA batches older than 3rd qtr past
  1.  D SELFL
  1.  I Y'>0 Q
  1.  I TRNAME[("5010") D NFOUND^BAR50P00 Q
  1.  I TRNAME["HIPAA" D EN^BAREDP12
  1.  D CLNUP
  1.  Q
  1. SELFL ;Select file
  1.  S NOBTCH=1
  1.  ;D SELFL^BAR50FS
  1.  K DIC
  1.  S DIC="^BAREDI(""I"",DUZ(2),"
  1.  S DIC("W")="D VIEWLIST^BAREDP00"
  1.  W !
  1.  S DIC(0)="AEZQM"
  1.  S DIC("A")="Select file: "
  1.  ;S DIC("S")="I $$NEWFILE^BAREDP00(Y)" ;show only files newer than...12/20/2013 P.OTT TEST
  1.  K DD,DO
  1.  D ^DIC
  1.  I Y'>0 Q
  1.  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
  1.  S IMPDA=$P(Y,U)
  1.  S TRDA=$P(Y(0),U,3)
  1.  S HSTIME=$P(Y(0),U,2)
  1.  ;RPTLOOK set in REPORT tag - allow rpts on batches > 3quarters old
  1.  S HSTFILE=$P(Y(0),U,5)
  1.  I '$G(RPTLOOK) D  I 'Y G SELFL
  1.  . 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
  1.  S TRNAME=$$GET1^DIQ(90056.01,TRDA,.01)
  1.  I TRNAME'["HIPAA" D
  1.  .S BARCOL=$P(Y(0),U,6)
  1.  .S BARITM=$P(Y(0),U,7)
  1.  .I +BARCOL,+BARITM S NOBTCH=0
  1.  K DIC
  1.  Q
  1.  ;
  1. NEWFILE(Y) ;
  1.  N X,X1,X2
  1.  S X=^BAREDI("I",DUZ(2),Y,0)
  1.  S X=$P(X,"_ERA_",2)
  1.  S X=$P(X,"^",1) I X="" Q 1
  1.  S %DT="" D ^%DT
  1.  ;W !,X," = ",Y 
  1.  S X1=DT,X2=Y D ^%DTC I X>365 Q 0 ;W " > 365 DYAS" Q 0
  1.  Q 1
  1. SELCK ;
  1.  D SELCK^BAREDP0A
  1.  Q
  1.  ;
  1. BTCHCHK ; 
  1.  D INIT^BARUTL
  1.  K BARCOL,BARITM
  1.  D BATCH^BARFPST
  1.  ; Returns BARCOL
  1.  I '$G(BARCOL) D  Q
  1.  .W !,"NO BATCH SELECTED ",!
  1.  .H 2
  1.  D ITEM^BARFPST
  1.  I +$G(BARCOL),+$G(BARITM)
  1.  E  D  Q
  1.  .W !,"NONE SELECTED ",!
  1.  .H 2
  1.  K DIE,DR,DA
  1.  S DIE=$$DIC^XBDIQ1(90056.02)
  1.  S DA=IMPDA
  1.  S DR=".06////^S X=BARCOL;.07////^S X=BARITM"
  1.  D ^DIE
  1.  S NOBTCH=0
  1.  H 2
  1.  Q
  1. BTCHDISP ;
  1.  S SP="      "
  1.  D CLEAR^VALM1
  1.  I $G(BARCOL) D ENP^XBDIQ1(90051.01,"BARCOL",".01;8","BNM($J,")
  1.  W !,"Transport: ",$P($G(^BAREDI("1T",TRDA,0)),"^")
  1.  W !,"Created from ",$G(HSTFILE)," on ",$G(HSTIME)
  1.  W !!,"Batch: ",$G(BNM($J,.01))_"  "_$G(BNM($J,8))
  1.  I $G(BARCOL) D BBAL^BARPST(BARCOL)
  1.  W !!,"Item: "_$G(BARITM)
  1.  I $G(BARITM) D IBAL^BARPST(BARITM)
  1.  Q
  1. CLNUP ;
  1.  I $G(IMPDA) L -^BAREDI("I",IMPDA)
  1.  K XBDIR,X,Y,HSTFILE,ANS,IMPDA,TRDA,DATM,SEQ,TNAME
  1.  K HSTIME,BARCOL,BARITM
  1.  Q
  1. VIEWLIST ;EP
  1.  N I,BARCHK
  1.  W ?35,$P($G(^BAREDI("I",DUZ(2),+Y,0)),U,5)
  1.  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
  1.  S I=""
  1.  F  S I=$O(^BAREDI("I",DUZ(2),"F",I)) Q:I=""  D
  1.  . Q:'$D(^BAREDI("I",DUZ(2),"F",I,+Y))
  1.  . S BARCHK(I)=""
  1.  S I=""
  1.  F  S I=$O(BARCHK(I)) Q:I=""  W ?50,"CHK/EFT #: ",I,!
  1.  Q
  1. READ(BARPATH,BARFILE) ; EP
  1.  ; Read host file into ^TMP($J,"ERA")
  1.  N BARCNT,BARTXT,BARDONE
  1.  S (BARCNT,BARDONE)=0,BARREC=""
  1.  D OPEN^%ZISH("835FILE"_$J,BARPATH,BARFILE,"R")
  1.  I POP D  Q
  1.  . W !!,"Error opening file....please verify filename and directory and try again"
  1.  . S BARDONE=1
  1.  . D EOP^BARUTL(1)
  1.  S BARCNT=0,BARI=0 ;# OF DELIMITERS
  1.  F I=1:1 Q:BARCNT=3  D
  1.  . U IO READ *CH
  1.  . I CH=10 Q
  1.  . I CH=13 Q
  1.  . S BARI=BARI+1 I BARI=106 S BARDEL=$C(CH),BARCNT=1 ;GET DELIMITER
  1.  . S BARREC=BARREC_$C(CH)
  1.  . I BARI>106 I BARDEL=$C(CH) S BARCNT=BARCNT+1
  1.  D CLOSE^%ZISH("835FILE"_$J)
  1.  Q  ;EOR