BAR50IUT ; IHS/SD/LSL - UTILITY FOR TANSPORT FILE ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,21**;OCT 26, 2005
;;
; IHS/ASDS/LSL - 09/11/01 - V1.5 Patch 2 - NOIS CXX-0501-110014
; Allow deletion of ERA Import files
;
; IHS/SD/LSL - 09/18/03 - V1.7 Patch 4 - HIPAA
;
; IHS/SD/LSL - 06/23/04 - V1.8 Patch 1 - IM13589
; ERA file listing not working
;
;IHS/SD/LSL - 08/3/04 - V1.8 Patch 1 - IM14472
; lengthen filename to 50 characters
; FIELD CROSS REFERENCE CHANGED TO 80
; POST ROUTINE RE-INDEXS RECORDS
;
; *********************************************************************
;
PRTVARA(TRDA) ; EP
; PRINT POSTING VARIABLES BY VARIABLE NAME ALPHABETICAL
S VAR=""
F S VAR=$O(^BAREDI("1T",TRDA,10,"D",VAR)) Q:VAR="" D
. S SEGDA=0
. F S SEGDA=$O(^BAREDI("1T",TRDA,10,"D",VAR,SEGDA)) Q:SEGDA'>0 D
.. S SEGNM=$$VAL^XBDIQ1(90056.0101,"TRDA,SEGDA",.01)
.. S ELMDA=0
.. F S ELMDA=$O(^BAREDI("1T",TRDA,10,"D",VAR,SEGDA,ELMDA)) Q:ELMDA'>0 D
... K ELM
... D ENP^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",".01;.02","ELM(")
... W !,VAR,?12,SEGNM,?25,ELM(.01),?35,ELM(.02)
Q
; *********************************************************************
;
PRTVARS(TRDA) ; EP
; PRINT POSTING VARIABLES BY SEGMENT ORDER
S SEGNM="",SEGLNM=""
F S SEGNM=$O(^BAREDI("1T",TRDA,10,"B",SEGNM)) Q:SEGNM="" D
. S SEGDA=$O(^BAREDI("1T",TRDA,10,"B",SEGNM,0))
. Q:'SEGDA
. I '$D(^BAREDI("1T",TRDA,10,SEGDA,10,"C")) Q
. S SEQDA=0
. F S SEQDA=$O(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQDA)) Q:SEQDA'>0 D
.. S ELMDA=$O(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQDA,0))
.. K ELM
.. D ENP^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",".01;.02;.08","ELM(")
.. I '$L(ELM(.08)) Q
.. W !
.. W:SEGNM'=SEGLNM SEGNM
.. W ?20,ELM(.01),?30,ELM(.02),?65,ELM(.08)
.. S SEGLNM=SEGNM
Q
; *********************************************************************
;
VIEW(TRDA,IMPDA) ; EP
; Browse an Import
I '$G(TRDA) S TRDA=$$GET1^DIQ(90056.02,IMPDA,.03,"I")
Q:$G(TRDA)=""
Q:$G(IMPDA)=""
S BARIMP=$$GET1^DIQ(90056.02,IMPDA,.01)
D VIEWR^XBLM("PRINT^BAR50IUT(TRDA,IMPDA)","VIEW IMPORT: "_BARIMP)
Q
; *********************************************************************
;
RECPRT(RECDA) ;
; print an import record and its elements
; note SEQ in elements 1,2,3,4 .. may not be the
; the same as ELMDA , as SEQ=ELMDA(.03)
; use 'ac' index to look up element by sequence
;
; pull in the record and converted elements
I $D(^XUSEC("XUPROG",DUZ)) S ALL=1 ;PROGRAMMERS CAN SEE ALL SEGMENTS BAR*1.8*21 PER STATUS MTG
K REC
D ENP^XBDIQ1(90056.0202,"IMPDA,RECDA",".01:99","REC(")
I '$D(ALL),REC(.02)=PRVB S BARQUIT=0
I '$D(ALL),REC(.02)=PRVE S BARQUIT=1
I '$D(ALL),REC(.02)=TRLB S BARQUIT=0
I '$D(ALL),REC(.02)="PLB" S BARQUIT=0
Q:BARQUIT
W !!,"*",REC(.02),?10,REC(.03)
F SEQ=1:1 Q:'$D(REC(10,SEQ)) D
. Q:REC(10,SEQ)=""
. S PATH=REC(.04)
. S TRDA=+PATH
. S SEGDA=$P(PATH,",",2)
. S ELMDA=$$ELMSEQDA(TRDA,SEGDA,SEQ)
. S X=$$VAL^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",.02)
. W !,$E(X,1,25),?27,REC(10,SEQ)
;I RECDA=22 H 5
Q
; *********************************************************************
;
PRINT(TRDA,IMPDA) ; EP
; Print records of import IMPDA
Q:$G(TRDA)=""
Q:$G(IMPDA)=""
I 'TRDA S TRDA=$$GET1^DIQ(90056.02,IMPDA,.03,"I")
Q:$G(TRDA)=""
K ^TMP($J,"REC")
; pull provider start & end records
K TR
D ENP^XBDIQ1(90056.01,TRDA,".04;.05;.06","TR(")
S PRVB=TR(.04)
S PRVE=TR(.05)
S TRLB=TR(.06)
S BARQUIT=0
D ENPM^XBDIQ1(90056.0202,"IMPDA,0",.01,"^TMP($J,""REC"",")
S RECDA=0
F S RECDA=$O(^TMP($J,"REC",RECDA)) Q:RECDA'>0 D RECPRT(RECDA)
Q
; *********************************************************************
;
ELMSEQDA(TRDA,SEGDA,SEQ) ; EP
; return ELMDA given TRDA,SEGDA, SEQ
N X
S X=$O(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQ,0))
;
END ;
Q X
; *********************************************************************
;
CLAIMS(IMPDA) ; EP
; Print the Claims in a transport for posting
S CLMDA=0
F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:CLMDA'>0 D
. K CLM
. D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01:.09","CLM(")
. K ADJ
. D ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".01:.05","ADJ(")
Q
; *********************************************************************
;
STRIP(XX) ; EP
; Strip training spaces
N L S L=$L(XX)
F I=L:-1:1 S X=$E(XX,I) Q:X'=" " S XX=$E(XX,1,I-1)
Q XX
; *********************************************************************
;
DELIMP ; EP
; Delete an Import
K DIC,DR,DA
W !!,"This is to delete ERA Imports",!
S DIC=90056.02
S DIC(0)="AEQM"
S DIC("W")="W ?35,$P(^(0),U,5)"
D ^DIC
I Y'>0 D Q
. W !!,"None Chosen",!
. K DIR
. S DIR("A")="<CR> - Continue"
. S DIR(0)="E"
. D ^DIR
S IMPDA=+Y
K IMP
D ENP^XBDIQ1(90056.02,IMPDA,".01:.07","IMP(")
W !!,"IMPORT:",?15,IMP(.01)
W !,"EDI:",?15,IMP(.03),?40,"ERA:",?55,IMP(.05)
W !,"BATCH:",?15,IMP(.06),?40,"ITEM:",?55,IMP(.07),!!
K DIR
S DIR(0)="Y"
S DIR("B")="N"
D ^DIR
K DIR
I 'Y W !!,IMP(.01)," NOT DELETED ",! G DELIMP
K DA,DR,DIE
S DIDEL=90056.02
S DIE=$$DIC^XBDIQ1(90056.02)
S DR=".01///@"
S DA=IMPDA
D ^DIE
W !!,IMP(.01)," DELETED",!
G DELIMP
; *********************************************************************
;
FNAME ; EP
; Select a file (directory can be pre-loaded into XBDIR)
K DIR
;
FNAME1 ;
S XBFN=""
;S DIR(0)="FO^1:30"
S DIR(0)="FO^1:50" ;IM14472
S DIR("A")="File Name "
D ^DIR
K DIR
Q:$G(DTOUT)
Q:Y["^"
Q:Y=""
Q:Y=" " ;IHS/SD/TPF 10/4/2011 BAR*1.8*21 ERROR DURING TESTING
I Y?.N,$D(XBFL(Y)) S DIR("B")=XBFL(Y) G FNAME1
I Y["*" D G FNAME
. K XBFL
. S X=$$LIST^%ZISH(XBDIR,Y,.XBFL)
. ;F XBI=1:1 Q:'$D(XBFL(XBI)) W !?5,XBI,?10,XBFL(XBI) I '(XBI#20) R X:DTIME
. S XBI="" F S XBI=$O(XBFL(XBI)) Q:XBI=""!($G(X)=U) W !?5,XBI,?10,XBFL(XBI) I '(XBI#20) R X:DTIME ;IM13589
S XBFN=Y
Q
BAR50IUT ; IHS/SD/LSL - UTILITY FOR TANSPORT FILE ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,21**;OCT 26, 2005
+2 ;;
+3 ; IHS/ASDS/LSL - 09/11/01 - V1.5 Patch 2 - NOIS CXX-0501-110014
+4 ; Allow deletion of ERA Import files
+5 ;
+6 ; IHS/SD/LSL - 09/18/03 - V1.7 Patch 4 - HIPAA
+7 ;
+8 ; IHS/SD/LSL - 06/23/04 - V1.8 Patch 1 - IM13589
+9 ; ERA file listing not working
+10 ;
+11 ;IHS/SD/LSL - 08/3/04 - V1.8 Patch 1 - IM14472
+12 ; lengthen filename to 50 characters
+13 ; FIELD CROSS REFERENCE CHANGED TO 80
+14 ; POST ROUTINE RE-INDEXS RECORDS
+15 ;
+16 ; *********************************************************************
+17 ;
PRTVARA(TRDA) ; EP
+1 ; PRINT POSTING VARIABLES BY VARIABLE NAME ALPHABETICAL
+2 SET VAR=""
+3 FOR
SET VAR=$ORDER(^BAREDI("1T",TRDA,10,"D",VAR))
IF VAR=""
QUIT
Begin DoDot:1
+4 SET SEGDA=0
+5 FOR
SET SEGDA=$ORDER(^BAREDI("1T",TRDA,10,"D",VAR,SEGDA))
IF SEGDA'>0
QUIT
Begin DoDot:2
+6 SET SEGNM=$$VAL^XBDIQ1(90056.0101,"TRDA,SEGDA",.01)
+7 SET ELMDA=0
+8 FOR
SET ELMDA=$ORDER(^BAREDI("1T",TRDA,10,"D",VAR,SEGDA,ELMDA))
IF ELMDA'>0
QUIT
Begin DoDot:3
+9 KILL ELM
+10 DO ENP^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",".01;.02","ELM(")
+11 WRITE !,VAR,?12,SEGNM,?25,ELM(.01),?35,ELM(.02)
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ; *********************************************************************
+14 ;
PRTVARS(TRDA) ; EP
+1 ; PRINT POSTING VARIABLES BY SEGMENT ORDER
+2 SET SEGNM=""
SET SEGLNM=""
+3 FOR
SET SEGNM=$ORDER(^BAREDI("1T",TRDA,10,"B",SEGNM))
IF SEGNM=""
QUIT
Begin DoDot:1
+4 SET SEGDA=$ORDER(^BAREDI("1T",TRDA,10,"B",SEGNM,0))
+5 IF 'SEGDA
QUIT
+6 IF '$DATA(^BAREDI("1T",TRDA,10,SEGDA,10,"C"))
QUIT
+7 SET SEQDA=0
+8 FOR
SET SEQDA=$ORDER(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQDA))
IF SEQDA'>0
QUIT
Begin DoDot:2
+9 SET ELMDA=$ORDER(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQDA,0))
+10 KILL ELM
+11 DO ENP^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",".01;.02;.08","ELM(")
+12 IF '$LENGTH(ELM(.08))
QUIT
+13 WRITE !
+14 IF SEGNM'=SEGLNM
WRITE SEGNM
+15 WRITE ?20,ELM(.01),?30,ELM(.02),?65,ELM(.08)
+16 SET SEGLNM=SEGNM
End DoDot:2
End DoDot:1
+17 QUIT
+18 ; *********************************************************************
+19 ;
VIEW(TRDA,IMPDA) ; EP
+1 ; Browse an Import
+2 IF '$GET(TRDA)
SET TRDA=$$GET1^DIQ(90056.02,IMPDA,.03,"I")
+3 IF $GET(TRDA)=""
QUIT
+4 IF $GET(IMPDA)=""
QUIT
+5 SET BARIMP=$$GET1^DIQ(90056.02,IMPDA,.01)
+6 DO VIEWR^XBLM("PRINT^BAR50IUT(TRDA,IMPDA)","VIEW IMPORT: "_BARIMP)
+7 QUIT
+8 ; *********************************************************************
+9 ;
RECPRT(RECDA) ;
+1 ; print an import record and its elements
+2 ; note SEQ in elements 1,2,3,4 .. may not be the
+3 ; the same as ELMDA , as SEQ=ELMDA(.03)
+4 ; use 'ac' index to look up element by sequence
+5 ;
+6 ; pull in the record and converted elements
+7 ;PROGRAMMERS CAN SEE ALL SEGMENTS BAR*1.8*21 PER STATUS MTG
IF $DATA(^XUSEC("XUPROG",DUZ))
SET ALL=1
+8 KILL REC
+9 DO ENP^XBDIQ1(90056.0202,"IMPDA,RECDA",".01:99","REC(")
+10 IF '$DATA(ALL)
IF REC(.02)=PRVB
SET BARQUIT=0
+11 IF '$DATA(ALL)
IF REC(.02)=PRVE
SET BARQUIT=1
+12 IF '$DATA(ALL)
IF REC(.02)=TRLB
SET BARQUIT=0
+13 IF '$DATA(ALL)
IF REC(.02)="PLB"
SET BARQUIT=0
+14 IF BARQUIT
QUIT
+15 WRITE !!,"*",REC(.02),?10,REC(.03)
+16 FOR SEQ=1:1
IF '$DATA(REC(10,SEQ))
QUIT
Begin DoDot:1
+17 IF REC(10,SEQ)=""
QUIT
+18 SET PATH=REC(.04)
+19 SET TRDA=+PATH
+20 SET SEGDA=$PIECE(PATH,",",2)
+21 SET ELMDA=$$ELMSEQDA(TRDA,SEGDA,SEQ)
+22 SET X=$$VAL^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",.02)
+23 WRITE !,$EXTRACT(X,1,25),?27,REC(10,SEQ)
End DoDot:1
+24 ;I RECDA=22 H 5
+25 QUIT
+26 ; *********************************************************************
+27 ;
PRINT(TRDA,IMPDA) ; EP
+1 ; Print records of import IMPDA
+2 IF $GET(TRDA)=""
QUIT
+3 IF $GET(IMPDA)=""
QUIT
+4 IF 'TRDA
SET TRDA=$$GET1^DIQ(90056.02,IMPDA,.03,"I")
+5 IF $GET(TRDA)=""
QUIT
+6 KILL ^TMP($JOB,"REC")
+7 ; pull provider start & end records
+8 KILL TR
+9 DO ENP^XBDIQ1(90056.01,TRDA,".04;.05;.06","TR(")
+10 SET PRVB=TR(.04)
+11 SET PRVE=TR(.05)
+12 SET TRLB=TR(.06)
+13 SET BARQUIT=0
+14 DO ENPM^XBDIQ1(90056.0202,"IMPDA,0",.01,"^TMP($J,""REC"",")
+15 SET RECDA=0
+16 FOR
SET RECDA=$ORDER(^TMP($JOB,"REC",RECDA))
IF RECDA'>0
QUIT
DO RECPRT(RECDA)
+17 QUIT
+18 ; *********************************************************************
+19 ;
ELMSEQDA(TRDA,SEGDA,SEQ) ; EP
+1 ; return ELMDA given TRDA,SEGDA, SEQ
+2 NEW X
+3 SET X=$ORDER(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQ,0))
+4 ;
END ;
+1 QUIT X
+2 ; *********************************************************************
+3 ;
CLAIMS(IMPDA) ; EP
+1 ; Print the Claims in a transport for posting
+2 SET CLMDA=0
+3 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))
IF CLMDA'>0
QUIT
Begin DoDot:1
+4 KILL CLM
+5 DO ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01:.09","CLM(")
+6 KILL ADJ
+7 DO ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".01:.05","ADJ(")
End DoDot:1
+8 QUIT
+9 ; *********************************************************************
+10 ;
STRIP(XX) ; EP
+1 ; Strip training spaces
+2 NEW L
SET L=$LENGTH(XX)
+3 FOR I=L:-1:1
SET X=$EXTRACT(XX,I)
IF X'=" "
QUIT
SET XX=$EXTRACT(XX,1,I-1)
+4 QUIT XX
+5 ; *********************************************************************
+6 ;
DELIMP ; EP
+1 ; Delete an Import
+2 KILL DIC,DR,DA
+3 WRITE !!,"This is to delete ERA Imports",!
+4 SET DIC=90056.02
+5 SET DIC(0)="AEQM"
+6 SET DIC("W")="W ?35,$P(^(0),U,5)"
+7 DO ^DIC
+8 IF Y'>0
Begin DoDot:1
+9 WRITE !!,"None Chosen",!
+10 KILL DIR
+11 SET DIR("A")="<CR> - Continue"
+12 SET DIR(0)="E"
+13 DO ^DIR
End DoDot:1
QUIT
+14 SET IMPDA=+Y
+15 KILL IMP
+16 DO ENP^XBDIQ1(90056.02,IMPDA,".01:.07","IMP(")
+17 WRITE !!,"IMPORT:",?15,IMP(.01)
+18 WRITE !,"EDI:",?15,IMP(.03),?40,"ERA:",?55,IMP(.05)
+19 WRITE !,"BATCH:",?15,IMP(.06),?40,"ITEM:",?55,IMP(.07),!!
+20 KILL DIR
+21 SET DIR(0)="Y"
+22 SET DIR("B")="N"
+23 DO ^DIR
+24 KILL DIR
+25 IF 'Y
WRITE !!,IMP(.01)," NOT DELETED ",!
GOTO DELIMP
+26 KILL DA,DR,DIE
+27 SET DIDEL=90056.02
+28 SET DIE=$$DIC^XBDIQ1(90056.02)
+29 SET DR=".01///@"
+30 SET DA=IMPDA
+31 DO ^DIE
+32 WRITE !!,IMP(.01)," DELETED",!
+33 GOTO DELIMP
+34 ; *********************************************************************
+35 ;
FNAME ; EP
+1 ; Select a file (directory can be pre-loaded into XBDIR)
+2 KILL DIR
+3 ;
FNAME1 ;
+1 SET XBFN=""
+2 ;S DIR(0)="FO^1:30"
+3 ;IM14472
SET DIR(0)="FO^1:50"
+4 SET DIR("A")="File Name "
+5 DO ^DIR
+6 KILL DIR
+7 IF $GET(DTOUT)
QUIT
+8 IF Y["^"
QUIT
+9 IF Y=""
QUIT
+10 ;IHS/SD/TPF 10/4/2011 BAR*1.8*21 ERROR DURING TESTING
IF Y=" "
QUIT
+11 IF Y?.N
IF $DATA(XBFL(Y))
SET DIR("B")=XBFL(Y)
GOTO FNAME1
+12 IF Y["*"
Begin DoDot:1
+13 KILL XBFL
+14 SET X=$$LIST^%ZISH(XBDIR,Y,.XBFL)
+15 ;F XBI=1:1 Q:'$D(XBFL(XBI)) W !?5,XBI,?10,XBFL(XBI) I '(XBI#20) R X:DTIME
+16 ;IM13589
SET XBI=""
FOR
SET XBI=$ORDER(XBFL(XBI))
IF XBI=""!($GET(X)=U)
QUIT
WRITE !?5,XBI,?10,XBFL(XBI)
IF '(XBI#20)
READ X:DTIME
End DoDot:1
GOTO FNAME
+17 SET XBFN=Y
+18 QUIT
