BAR50P00 ; IHS/SD/LSL - AR ERA AUTO-POSTIEG ; 01/30/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,5,6,7,10,17,20,23,28**;OCT 26,2005;Build 92
;P23: JAN 2013 P.OTTIS: AUTO-SELECT THE TRANSPORT TYPE ($$FORMAT)
;IHS/DIT/CPC CR9572 ADD REVIEW FLAG WHEN ENTERING REVIEW EP - BAR*1.8*28
Q
TSEL ;EP TRANSPORT SELECT (DEFUNTC)
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
INSTALL ;EP - Load New Import (DEFUNCT)
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^BAR50IUT
S HSTFILE=$G(XBFN)
Q:HSTFILE=""
;PER EMAILS MOVE FORMAT CHECK BEFORE FILE LOAD BAR*1.8*21
W !!,"CHECKING FILE FORMAT....."
S BARCTRL=0
D READ^BAR50PA1(XBDIR,HSTFILE) ;Read file into ^TMP($J,"ERA")
Q:+$G(POP)
S BARHIPAA=$$FORMAT
I TRNAME["HIPAA",'+BARHIPAA D Q
.W !,"The file ",HSTFILE," in directory ",XBDIR
.W !,"is not a HIPAA compliant 835 5010 Remittance Advice. It cannot be loaded."
.D EOP^BARUTL(1)
I TRNAME'["HIPAA",+BARHIPAA D Q
.W !,"The file ",HSTFILE," in directory ",XBDIR
.W !,"is a HIPAA compliant 835 Remittance Advice."
.W !,"Please use the HIPAA 835 v5010 Transport when loading this file."
.D EOP^BARUTL(1)
W !!,"FILE FORMAT OKAY."
; Chk if host file was prev. loaded
Q ;--------------------------------------
;
;ENTRY POINT FROM BAREDP00
;
5010 ;ep
K FILE
S ANS="Y"
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") ;bar*1.8*20 REQ4
. W !!,"This file was previously loaded on "_LOADDT_" as",!?2,"file "_FILE ;bar*1.8*20 REQ4
. 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^BAR50P0A(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^BAR50PA1(XBDIR,HSTFILE)
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
;;;w !,"------------------------------" zw w !,"-----------------------------------"
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" ;bar*1.8*20 REQ1
D EN^BAR50P01(TRDA,IMPDA)
W !,"Stage 1 -> Complete"
; Parse segmts into elemts & valueS
W !!,"Starting stage 2 of 3 -> Parse segments into elements & values" ;bar*1.8*20 REQ1
D EN^BAR50P02(TRDA,IMPDA)
D CHKS^BAR50P02(IMPDA) ;bar*1.8*20 REQ2
W !," Stand by to print TRN - Check Number/Check Amount Report..." ;bar*1.8*20 REQ4
D EN1^BAR50PCS ;bar*1.8*20 REQ2
W !,"Stage 2 -> Complete"
; Build postable clms
W !!,"Starting stage 3 of 3 -> Build postable claims" ;bar*1.8*20 REQ1
H 1
D EN^BAR50P03(TRDA,IMPDA)
W !,"Stage 3 -> Complete"
D EOP^BARUTL(1)
Q
PLB ;Chk for PLB/Pymt Reversals
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^BAR50P04(TRDA,IMPDA)
I '+$G(QFLG) W !!,"Matching complete" ;bar*1.8*20 REQ4
I +$G(QFLG) W !!,"Matching NOT complete" ;bar*1.8*20 REQ4
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() ;REWRITTEN BT P.OTT
; Verify file loading is HIPAA 835 if Transport is HIPAA 835
; Return 0 if wrong format
; Return 1 if correct format
K BARSSEP,BARESEP,BARCSEP
N BARTMP,BARGS08,X,I
S BARCTRL=0
F I=1:1:3 D
. S BARTMP=$G(BARTMP)_$G(^TMP($J,"ERA",I)) ;BAR*1.8*1 TPF 1/25/2006 IM19629
. S X=$L(BARTMP)
. I $A($E(BARTMP,X))<32 S BARTMP=$E(BARTMP,1,X-1)
. I $A($E(BARTMP,X))>127 S BARTMP=$E(BARTMP,1,X-1)
; BARTMP = 1st 3 lines of file
I $E(BARTMP,1,3)'="ISA" Q 0 ;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" Q 0 ;GS01 must be HP for 835
S BARGS08=$P($P(BARTMP,BARSSEP,2),BARESEP,9)
I BARGS08'["005010X221" Q 0 ;HIPAA 5010 X12 Version BAR*1.8*21
Q 1
REVIEW ;EP
D ERACHECK^BAR50P09
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
S BARRVW=1 ;IHS/DIT/CPC - BAR*1.8*28
D EN^BAR50P05
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 TRNAME["HIPAA" D Q
. S BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"POST")
. Q:'+BARCKIEN
. D POST^BAR50P08(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)
;user posts ea batch & status of clms go from 'M' to 'P'
I X="Y" D
. D EN^BAR50P06(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
D VIEW^BAR50IUT(TRDA,IMPDA)
D CLNUP
Q
REPORT ; EP
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^BAR50P10
I TRNAME'["HIPAA" D EN^BAR50P07
D CLNUP
Q
NFOUND ; EP
I TRNAME["HIPAA" D EN^BAR50P12
D CLNUP
Q
SELFL ;Select file
S NOBTCH=1
K DIC
S DIC="^BAREDI(""I"",DUZ(2),"
S DIC("W")="D VIEWLIST^BAR50P00"
W !
S DIC(0)="AEZQM"
S DIC("A")="Select file: "
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
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
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
SELCK ;select chk in file
D SELCK^BAR50P0A
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
;Returns BARITM
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 ;Display Batch & transport dtls
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 ;Cleanup vars
I $G(IMPDA) L -^BAREDI("I",IMPDA) ;BAR*1.8*5 SRS-80 TPF
K XBDIR,X,Y,HSTFILE,ANS,IMPDA,TRDA,DATM,SEQ,TNAME
K HSTIME,BARCOL,BARITM
; Added below IHS/DIT/CPC BAR*1.8*28
K ACAT,ADJDA,ALMCOFF,ALMCON,AREA,BAR,BAR1,BAR3PIEN,BAR3PLOC,BARAMT
K BARANS,BARANS1,BARBAL,BARBDT,BARBIEN,BARBILL,BARBL,BARBLIEN,BARBSTAT,BARBTCH
K BARCAT,BARCATN,BARCDT,BARCHK,BARCKIEN,BARCNT,BARCNT2,BARDONE,BAREIENS,BARFLG
K BARHOLD,BARITEM,BARL1,BARL2,BARL3,BARL3DD,BARL3FMT,BARL3MM,BARL3YY,BARL4
K BARL5,BARL6,BARMM,BARMMCNT,BARMMFLG,BARMMVAL,BARNTPR,BARQT,BARQTR,BARRADT
K BARRCHK,BARSAVE,BARSEL,BARSTAT,BARTABT,BARTBTCH,BARTEST,BARTFLG,BARTITEM,BARTMP
K BARTMP2,BARTOT2,BARTR,BARVDF,BARX,BARYYY,BARYYY2,BARYYY3,BILMATCH,BPOSTBAL
K CHKREASN,CLMCNT,CLMDA,CLMFLG,CLMPYMT,CNT,D,D0,DA,DDER
K DI,DIC,DIE,DIQ,DR,EAMT,EBILL,EDA,EFLD,EFN,ELIST,ERECORD,ESTAT,FHDR,HSTFILE,HSTIME,I
K IENS,IMPDA,INDEX,MAMT,MATCH,MDA,MTCHAMT,NEWSTAT,NOBTCH,PLBAMT,POP
K QFLG,REVAMT,REASDA,RECNM,REVDA,RHEADER,RN,RPT,RRECORD,SHOWMSG,STATUS
K THDR,TRDA,TRNAME,VALMIOXY,VALMSGR,VALMWD,VALMY,WHOLELST
K ^XTMP("BAR-LIST",$J),^XTMP("BAR-LIST_DETAIL",$J),^XTMP("BAR-MBAMT",$J),^XTMP("BAR-REV",$J)
K ^TMP($J,"A"),^TMP($J,"E"),^TMP($J,"LVL1"),^TMP("VALM DATA",$J)
Q
VIEWLIST ;EP
;Display all chks tied to file when looking for files
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 ;bar*1.8*20 REQ4
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,! ;bar*1.8*20 REQ4
Q
BAR50P00 ; IHS/SD/LSL - AR ERA AUTO-POSTIEG ; 01/30/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,5,6,7,10,17,20,23,28**;OCT 26,2005;Build 92
+2 ;P23: JAN 2013 P.OTTIS: AUTO-SELECT THE TRANSPORT TYPE ($$FORMAT)
+3 ;IHS/DIT/CPC CR9572 ADD REVIEW FLAG WHEN ENTERING REVIEW EP - BAR*1.8*28
+4 QUIT
TSEL ;EP TRANSPORT SELECT (DEFUNTC)
+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
INSTALL ;EP - Load New Import (DEFUNCT)
+1 KILL ^TMP($JOB,"ERA")
+2 SET DIR(0)="F"
+3 SET DIR("A")="Enter the directory path for the transport file"
+4 SET BARPATH=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),0)),U,17)
+5 SET DIR("B")=BARPATH
+6 SET DIR("?")="For example enter '/usr/mydir/'"
+7 DO ^DIR
+8 KILL DIR
+9 IF $DATA(DIRUT)
QUIT
+10 ; Path
+11 SET XBDIR=X
+12 DO FNAME^BAR50IUT
+13 SET HSTFILE=$GET(XBFN)
+14 IF HSTFILE=""
QUIT
+15 ;PER EMAILS MOVE FORMAT CHECK BEFORE FILE LOAD BAR*1.8*21
+16 WRITE !!,"CHECKING FILE FORMAT....."
+17 SET BARCTRL=0
+18 ;Read file into ^TMP($J,"ERA")
DO READ^BAR50PA1(XBDIR,HSTFILE)
+19 IF +$GET(POP)
QUIT
+20 SET BARHIPAA=$$FORMAT
+21 IF TRNAME["HIPAA"
IF '+BARHIPAA
Begin DoDot:1
+22 WRITE !,"The file ",HSTFILE," in directory ",XBDIR
+23 WRITE !,"is not a HIPAA compliant 835 5010 Remittance Advice. It cannot be loaded."
+24 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+25 IF TRNAME'["HIPAA"
IF +BARHIPAA
Begin DoDot:1
+26 WRITE !,"The file ",HSTFILE," in directory ",XBDIR
+27 WRITE !,"is a HIPAA compliant 835 Remittance Advice."
+28 WRITE !,"Please use the HIPAA 835 v5010 Transport when loading this file."
+29 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+30 WRITE !!,"FILE FORMAT OKAY."
+31 ; Chk if host file was prev. loaded
+32 ;--------------------------------------
QUIT
+33 ;
+34 ;ENTRY POINT FROM BAREDP00
+35 ;
5010 ;ep
+1 KILL FILE
+2 SET ANS="Y"
+3 IF $DATA(^BAREDI("I",DUZ(2),"C",HSTFILE))
Begin DoDot:1
+4 SET IEN=$ORDER(^BAREDI("I",DUZ(2),"C",HSTFILE,9999999),-1)
+5 SET LOADDT=""
+6 ;bar*1.8*20 REQ4
IF (+IEN'=0)
SET LOADDT=$$GET1^DIQ(90056.02,IEN,".02")
SET FILE=$$GET1^DIQ(90056.02,IEN,".01")
+7 ;bar*1.8*20 REQ4
WRITE !!,"This file was previously loaded on "_LOADDT_" as",!?2,"file "_FILE
+8 WRITE !!,?5," You can exit and review the import by entering"
+9 WRITE !,?5," the filename in the View Import Header option.",!
+10 WRITE !,"NOTE: reloading a file will create duplicate entries in the A/R EDI Check!"
+11 WRITE !,"Proceed with caution"
+12 SET BARFLG=1
+13 SET BARFLG=$$POSTCHK^BAR50P0A(IEN)
+14 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."
+15 IF BARFLG=0
Begin DoDot:2
+16 WRITE !!!,"Part of this file has been POSTED and is therefore not eligible for reload."
End DoDot:2
SET ANS="N"
QUIT
+17 SET DIR(0)="Y"
+18 SET DIR("A")="Do you wish to reload this file"
+19 SET DIR("B")="N"
+20 SET DIR("?")="Enter 'Y' to re-install transport file: "
+21 DO ^DIR
+22 IF $DATA(DIRUT)!Y=0
SET ANS="N"
QUIT
+23 IF BARFLG=1
Begin DoDot:2
+24 KILL DIR
+25 SET DIR(0)="Y"
+26 SET DIR("A")="Are you sure?"
+27 SET DIR("B")="N"
+28 SET DIR("?")="Enter 'Y' to re-install transport file: "
+29 DO ^DIR
End DoDot:2
+30 IF BARFLG=1
IF $DATA(DIRUT)!(ANS'="Y")
QUIT
+31 KILL DIR
+32 SET ANS=$SELECT(+Y:"Y",1:"N")
+33 IF ANS'="Y"
QUIT
End DoDot:1
IF ANS="N"
QUIT
+34 IF ANS'="Y"
QUIT
+35 KILL XBY,XBGUI
+36 WRITE !!,"File",?25,"Directory",?50,"Transport"
+37 WRITE !,HSTFILE,?25,XBDIR,?50,TRNAME,!!
+38 SET DIR(0)="Y"
+39 SET DIR("A")="Do you want to proceed"
+40 SET DIR("B")="N"
+41 SET DIR("?")="Enter 'Y' to install transport file: "
+42 DO ^DIR
+43 KILL DIR
+44 IF $DATA(DIRUT)
QUIT
+45 IF '+Y
QUIT
+46 IF +$GET(BARFLG)=1
Begin DoDot:1
+47 SET DIK=$$DIC^XBDIQ1(90056.02)
+48 SET DA=IEN
+49 DO ^DIK
End DoDot:1
+50 SET BARCTRL=0
+51 DO READ^BAR50PA1(XBDIR,HSTFILE)
+52 IF +$GET(POP)
QUIT
+53 DO EOP^BARUTL(1)
+54 IF '$DATA(^TMP($JOB,"ERA"))
Begin DoDot:1
+55 WRITE !,"The file ",HSTFILE," in directory ",XBDIR
+56 WRITE !,"Appears to be an empty file."
+57 WRITE !,"Empty files are not HIPAA compliant."
+58 WRITE !,"Inform your source and request a HIPAA compliant file"
+59 WRITE !,"Please contact your supervisor for assistance."
+60 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+61 DO CLEAR^VALM1
+62 SET X=$ORDER(^TMP($JOB,"ERA",""),-1)
+63 WRITE !,"LINE COUNT LOADED: ",X,!
+64 HANG 3
+65 IF X'>0
GOTO INSTALL
+66 KILL DIC
+67 SET DIC=$$DIC^XBDIQ1(90056.02)
+68 SET DIC(0)="EL"
+69 SET X=HSTFILE
+70 ;bar*1.8*20
IF $GET(FILE)
SET DINUM=($PIECE(FILE,"_")-1000)
+71 KILL DD,DO
+72 ;;;w !,"------------------------------" zw w !,"-----------------------------------"
+73 DO FILE^DICN
+74 SET IMPDA=+Y
+75 KILL DIC
+76 IF +Y<1
Begin DoDot:1
+77 WRITE !!,"File not created for transport"
+78 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+79 DO NOW^%DTC
+80 SET X=X+17000000
+81 SET DATE=$EXTRACT(X,5,6)_"/"_$EXTRACT(X,7,8)_"/"_$EXTRACT(X,1,4)
+82 DO YX^%DTC
+83 SET DATM=Y
+84 SET SEQ=1000+IMPDA
+85 SET TNAME=SEQ_"_ERA_"_DATE
+86 WRITE TNAME,!
HANG 3
+87 KILL DIE,DR,DA
+88 SET DIE=$$DIC^XBDIQ1(90056.02)
+89 SET DA=IMPDA
+90 SET DR=".01///^S X=TNAME"
+91 SET DR=DR_";.04////^S X=XBDIR"
+92 SET DR=DR_";.05////^S X=HSTFILE"
+93 SET DR=DR_";.02////^S X=DATM"
+94 SET DR=DR_";.03////^S X=TRDA"
+95 DO ^DIE
+96 ;Convert ^TMP($J,"ERA") to ^BAREDI("I",DUZ(2))
+97 SET ^BAREDI("I",DUZ(2),IMPDA,10,0)=""
+98 SET BARCNTL=0
+99 IF +BARCTRL
Begin DoDot:1
+100 SET BARESEP=$ASCII(BARESEP)
+101 SET BARSSEP=$ASCII(BARSSEP)
+102 SET BARCSEP=$ASCII(BARCSEP)
End DoDot:1
+103 SET X=""
+104 FOR
SET X=$ORDER(^TMP($JOB,"ERA",X))
IF X=""
QUIT
Begin DoDot:1
+105 SET BARTMP=^TMP($JOB,"ERA",X)
+106 ;Separators=ctrl char
IF +BARCTRL
Begin DoDot:2
+107 FOR I=1:1:$LENGTH(BARTMP)
Begin DoDot:3
+108 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
+109 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
+110 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
+111 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
+112 IF '+BARCTRL
Begin DoDot:2
+113 FOR I=1:1:$LENGTH(BARTMP)
Begin DoDot:3
+114 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
+115 IF '+$LENGTH(BARTMP)
QUIT
+116 SET BARCNTL=BARCNTL+1
+117 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 ;bar*1.8*20 REQ1
WRITE !,"Starting stage 1 of 3 -> Extract data from transport to segments"
+12 DO EN^BAR50P01(TRDA,IMPDA)
+13 WRITE !,"Stage 1 -> Complete"
+14 ; Parse segmts into elemts & valueS
+15 ;bar*1.8*20 REQ1
WRITE !!,"Starting stage 2 of 3 -> Parse segments into elements & values"
+16 DO EN^BAR50P02(TRDA,IMPDA)
+17 ;bar*1.8*20 REQ2
DO CHKS^BAR50P02(IMPDA)
+18 ;bar*1.8*20 REQ4
WRITE !," Stand by to print TRN - Check Number/Check Amount Report..."
+19 ;bar*1.8*20 REQ2
DO EN1^BAR50PCS
+20 WRITE !,"Stage 2 -> Complete"
+21 ; Build postable clms
+22 ;bar*1.8*20 REQ1
WRITE !!,"Starting stage 3 of 3 -> Build postable claims"
+23 HANG 1
+24 DO EN^BAR50P03(TRDA,IMPDA)
+25 WRITE !,"Stage 3 -> Complete"
+26 DO EOP^BARUTL(1)
+27 QUIT
PLB ;Chk for PLB/Pymt Reversals
+1 SET BARCNT=0
SET I=0
+2 FOR
SET I=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,I))
IF 'I
QUIT
Begin DoDot:1
+3 SET BARCNT=BARCNT+1
End DoDot:1
+4 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)
+5 ;if 1+ chk, pick 1
IF BARCNT>1
DO SELCK
+6 IF +$GET(BARCKIEN)'>0
QUIT
+7 SET BARQT=0
SET BARQUIT=1
+8 IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M"))
Begin DoDot:1
+9 SET CLMDA=0
+10 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M",CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)=BARCHK
SET BARQT=1
End DoDot:2
IF BARQT
QUIT
+12 IF 'BARQT
QUIT
+13 WRITE !!,"Bill matching for this check has already been done."
+14 KILL DIR
+15 SET DIR(0)="Y"
+16 SET DIR("A")="Do you want to do matching again"
+17 DO ^DIR
KILL DIR
+18 SET BARQUIT=+Y
End DoDot:1
+19 IF 'BARQUIT
QUIT
+20 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",!
+21 WRITE !,"I will begin bill matching..."
+22 HANG 1
+23 DO EN^BAR50P04(TRDA,IMPDA)
+24 ;bar*1.8*20 REQ4
IF '+$GET(QFLG)
WRITE !!,"Matching complete"
+25 ;bar*1.8*20 REQ4
IF +$GET(QFLG)
WRITE !!,"Matching NOT complete"
+26 SET DIE=$$DIC^XBDIQ1(90056.02)
+27 SET DA=IMPDA
+28 SET DR=".08////M"
+29 DO ^DIE
+30 KILL DIR
+31 SET DIR(0)="E"
+32 SET DIR("A")="<CR> - Continue"
+33 DO ^DIR
+34 DO CLEAR^VALM1
+35 DO CLNUP
+36 QUIT
FORMAT() ;REWRITTEN BT P.OTT
+1 ; Verify file loading is HIPAA 835 if Transport is HIPAA 835
+2 ; Return 0 if wrong format
+3 ; Return 1 if correct format
+4 KILL BARSSEP,BARESEP,BARCSEP
+5 NEW BARTMP,BARGS08,X,I
+6 SET BARCTRL=0
+7 FOR I=1:1:3
Begin DoDot:1
+8 ;BAR*1.8*1 TPF 1/25/2006 IM19629
SET BARTMP=$GET(BARTMP)_$GET(^TMP($JOB,"ERA",I))
+9 SET X=$LENGTH(BARTMP)
+10 IF $ASCII($EXTRACT(BARTMP,X))<32
SET BARTMP=$EXTRACT(BARTMP,1,X-1)
+11 IF $ASCII($EXTRACT(BARTMP,X))>127
SET BARTMP=$EXTRACT(BARTMP,1,X-1)
End DoDot:1
+12 ; BARTMP = 1st 3 lines of file
+13 ;all X12 messages start w/ ISA
IF $EXTRACT(BARTMP,1,3)'="ISA"
QUIT 0
+14 ;Element separator
SET BARESEP=$EXTRACT(BARTMP,4)
+15 IF $ASCII(BARESEP)<32!($ASCII(BARESEP)>126)
SET BARCTRL=1
+16 ;Segment separator
SET BARSSEP=$EXTRACT(BARTMP,106)
+17 IF $ASCII(BARSSEP)<32!($ASCII(BARSSEP)>126)
SET BARCTRL=1
+18 ;Component separator
SET BARCSEP=$EXTRACT(BARTMP,105)
+19 IF $ASCII(BARCSEP)<32!($ASCII(BARCSEP)>126)
SET BARCTRL=1
+20 IF DUZ=902
WRITE 1/0
+21 ;GS01 must be HP for 835
IF $EXTRACT($PIECE(BARTMP,BARSSEP,2),4,5)'="HP"
QUIT 0
+22 SET BARGS08=$PIECE($PIECE(BARTMP,BARSSEP,2),BARESEP,9)
+23 ;HIPAA 5010 X12 Version BAR*1.8*21
IF BARGS08'["005010X221"
QUIT 0
+24 QUIT 1
REVIEW ;EP
+1 DO ERACHECK^BAR50P09
+2 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)
+3 IF $ORDER(BARCHK(9999),-1)>1
DO SELCK
+4 IF +$GET(BARCKIEN)'>0
QUIT
+5 ;Review screen
+6 ;IHS/DIT/CPC - BAR*1.8*28
SET BARRVW=1
+7 DO EN^BAR50P05
+8 ;Mark chk as reviewed
IF TRNAME["HIPAA"
Begin DoDot:1
+9 DO NOW^%DTC
+10 SET BARDTREV=%
+11 KILL DIE,DIC,DA,DR,X,Y
+12 SET DIE="^BARECHK("
+13 SET DA=$PIECE(BARCHK(BARCKIEN),U,5)
+14 SET DR=".05///^S X=BARDTREV"
+15 SET DR=DR_";.06////^S X=DUZ"
+16 DO ^DIE
End DoDot:1
+17 DO CLNUP
+18 QUIT
POST ; EP
+1 IF TRNAME["HIPAA"
Begin DoDot:1
+2 SET BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"POST")
+3 IF '+BARCKIEN
QUIT
+4 DO POST^BAR50P08(BARCKIEN)
End DoDot:1
QUIT
+5 ;Get batch/item info
+6 IF NOBTCH
DO BTCHCHK
+7 IF 'NOBTCH
Begin DoDot:1
+8 DO BTCHDISP
+9 WRITE !
+10 SET DIR(0)="Y"
+11 SET DIR("A")="Do you want to select a different batch"
+12 SET DIR("B")="N"
+13 SET DIR("?")="Enter 'Y' to select a different batch "
+14 DO ^DIR
+15 KILL DIR
+16 IF $DATA(DIRUT)
QUIT
+17 SET NOBTCH=1
+18 IF X="Y"
DO BTCHCHK
End DoDot:1
+19 DO CLEAR^VALM1
+20 IF 'NOBTCH
DO BTCHDISP
+21 IF +$GET(BARCOL)
IF +$GET(BARITM)
+22 IF '$TEST
Begin DoDot:1
+23 WRITE !,"Batch & Item not selected ",!,"Adjustments only will be made,",!!
+24 HANG 2
+25 KILL BARCOL,BARITM
+26 KILL DR,DIE,DA,DIC
+27 SET DIE=$$DIC^XBDIQ1(90056.02)
+28 SET DA=IMPDA
+29 SET DR=".06///@;.07///@"
+30 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 ;user posts ea batch & status of clms go from 'M' to 'P'
+12 IF X="Y"
Begin DoDot:1
+13 DO EN^BAR50P06(TRDA,IMPDA)
+14 ;"Roll-over as you go" flag set to no
SET BARRAYGO=0
+15 ;Loops BARROLL array & marks for rollback
DO EN^BARROLL
+16 KILL BARROLL
End DoDot:1
+17 DO CLNUP
+18 QUIT
VIEW ; EP
+1 DO VIEW^BAR50IUT(TRDA,IMPDA)
+2 DO CLNUP
+3 QUIT
REPORT ; EP
+1 IF TRNAME["HIPAA"
Begin DoDot:1
+2 SET BARCKIEN=$$CHKSEL^BAREUTL(IMPDA,"REPORT")
End DoDot:1
IF '+BARCKIEN
QUIT
SET BARCHK=$$GET1^DIQ(90056.22,BARCKIEN,.01)
+3 IF TRNAME["HIPAA"
IF +BARCKIEN
DO EN^BAR50P10
+4 IF TRNAME'["HIPAA"
DO EN^BAR50P07
+5 DO CLNUP
+6 QUIT
NFOUND ; EP
+1 IF TRNAME["HIPAA"
DO EN^BAR50P12
+2 DO CLNUP
+3 QUIT
SELFL ;Select file
+1 SET NOBTCH=1
+2 KILL DIC
+3 SET DIC="^BAREDI(""I"",DUZ(2),"
+4 SET DIC("W")="D VIEWLIST^BAR50P00"
+5 WRITE !
+6 SET DIC(0)="AEZQM"
+7 SET DIC("A")="Select file: "
+8 KILL DD,DO
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 LOCK +^BAREDI("I",+Y):2
IF '$TEST
WRITE !,"THIS FILE IS BEING VIEWED, REVIEWED OR POSTED BY ANOTHER USER!! TRY AGAIN LATER."
GOTO SELFL
+12 SET IMPDA=$PIECE(Y,U)
+13 SET TRDA=$PIECE(Y(0),U,3)
+14 SET HSTIME=$PIECE(Y(0),U,2)
+15 ;RPTLOOK set in REPORT tag - allow rpts on batches > 3quarters old
+16 SET HSTFILE=$PIECE(Y(0),U,5)
IF '$GET(RPTLOOK)
Begin DoDot:1
+17 IF '$$CKDATE^BARPST(HSTFILE,1,"SELECT ERA FILE")
SET Y=0
KILL IMPDA
End DoDot:1
IF 'Y
GOTO SELFL
+18 SET TRNAME=$$GET1^DIQ(90056.01,TRDA,.01)
+19 IF TRNAME'["HIPAA"
Begin DoDot:1
+20 SET BARCOL=$PIECE(Y(0),U,6)
+21 SET BARITM=$PIECE(Y(0),U,7)
+22 IF +BARCOL
IF +BARITM
SET NOBTCH=0
End DoDot:1
+23 KILL DIC
+24 QUIT
SELCK ;select chk in file
+1 DO SELCK^BAR50P0A
+2 QUIT
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 ;Returns BARITM
+10 IF +$GET(BARCOL)
IF +$GET(BARITM)
+11 IF '$TEST
Begin DoDot:1
+12 WRITE !,"NONE SELECTED ",!
+13 HANG 2
End DoDot:1
QUIT
+14 KILL DIE,DR,DA
+15 SET DIE=$$DIC^XBDIQ1(90056.02)
+16 SET DA=IMPDA
+17 SET DR=".06////^S X=BARCOL;.07////^S X=BARITM"
+18 DO ^DIE
+19 SET NOBTCH=0
+20 HANG 2
+21 QUIT
BTCHDISP ;Display Batch & transport dtls
+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 ;Cleanup vars
+1 ;BAR*1.8*5 SRS-80 TPF
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 ; Added below IHS/DIT/CPC BAR*1.8*28
+5 KILL ACAT,ADJDA,ALMCOFF,ALMCON,AREA,BAR,BAR1,BAR3PIEN,BAR3PLOC,BARAMT
+6 KILL BARANS,BARANS1,BARBAL,BARBDT,BARBIEN,BARBILL,BARBL,BARBLIEN,BARBSTAT,BARBTCH
+7 KILL BARCAT,BARCATN,BARCDT,BARCHK,BARCKIEN,BARCNT,BARCNT2,BARDONE,BAREIENS,BARFLG
+8 KILL BARHOLD,BARITEM,BARL1,BARL2,BARL3,BARL3DD,BARL3FMT,BARL3MM,BARL3YY,BARL4
+9 KILL BARL5,BARL6,BARMM,BARMMCNT,BARMMFLG,BARMMVAL,BARNTPR,BARQT,BARQTR,BARRADT
+10 KILL BARRCHK,BARSAVE,BARSEL,BARSTAT,BARTABT,BARTBTCH,BARTEST,BARTFLG,BARTITEM,BARTMP
+11 KILL BARTMP2,BARTOT2,BARTR,BARVDF,BARX,BARYYY,BARYYY2,BARYYY3,BILMATCH,BPOSTBAL
+12 KILL CHKREASN,CLMCNT,CLMDA,CLMFLG,CLMPYMT,CNT,D,D0,DA,DDER
+13 KILL DI,DIC,DIE,DIQ,DR,EAMT,EBILL,EDA,EFLD,EFN,ELIST,ERECORD,ESTAT,FHDR,HSTFILE,HSTIME,I
+14 KILL IENS,IMPDA,INDEX,MAMT,MATCH,MDA,MTCHAMT,NEWSTAT,NOBTCH,PLBAMT,POP
+15 KILL QFLG,REVAMT,REASDA,RECNM,REVDA,RHEADER,RN,RPT,RRECORD,SHOWMSG,STATUS
+16 KILL THDR,TRDA,TRNAME,VALMIOXY,VALMSGR,VALMWD,VALMY,WHOLELST
+17 KILL ^XTMP("BAR-LIST",$JOB),^XTMP("BAR-LIST_DETAIL",$JOB),^XTMP("BAR-MBAMT",$JOB),^XTMP("BAR-REV",$JOB)
+18 KILL ^TMP($JOB,"A"),^TMP($JOB,"E"),^TMP($JOB,"LVL1"),^TMP("VALM DATA",$JOB)
+19 QUIT
VIEWLIST ;EP
+1 ;Display all chks tied to file when looking for files
+2 NEW I,BARCHK
+3 WRITE ?35,$PIECE($GET(^BAREDI("I",DUZ(2),+Y,0)),U,5)
+4 ;bar*1.8*20 REQ4
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
+5 SET I=""
+6 FOR
SET I=$ORDER(^BAREDI("I",DUZ(2),"F",I))
IF I=""
QUIT
Begin DoDot:1
+7 IF '$DATA(^BAREDI("I",DUZ(2),"F",I,+Y))
QUIT
+8 SET BARCHK(I)=""
End DoDot:1
+9 SET I=""
+10 ;bar*1.8*20 REQ4
FOR
SET I=$ORDER(BARCHK(I))
IF I=""
QUIT
WRITE ?50,"CHK/EFT #: ",I,!
+11 QUIT
