BAREDIUT ; IHS/SD/LSL - UTILITY FOR TANSPORT FILE ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,21,23**;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
; ;P.OTT HEAT# 80621
; *********************************************************************
;
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^BAREDIUT(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
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)
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
; *********************************************************************
;
STATUS() ;PREPARE STRING OF STATUSES OF CLAIMS P.OTT
NEW STR,STA
S STR=""
S STA="" F S STA=$O(^BAREDI("I",DUZ(2),Y,30,"AC",STA)) Q:STA="" S STR=STR_STA_" "
QUIT STR
DELIMP ; EP
; Delete an Import
K DIC,DR,DA
W !!,"This is to delete ERA Import file",!
S DIC=90056.02
S DIC(0)="AEQM"
S DIC("W")="W ?35,$P(^(0),U,5),?70,$$STATUS^BAREDIUT()" ;P.OTT DISPLAY STATUS(ES)
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
I $D(^BAREDI("I",DUZ(2),IMPDA,30,"AC","P")) D QUIT ;P.OTT
. W !,"This file has one or more posted claims. Cannot delete."
. K DIR
. S DIR("A")="hit ^ to return"
. S DIR(0)="E"
. D ^DIR
;E W !,"No posted claims for this file. "
K IMP
D ENP^XBDIQ1(90056.02,IMPDA,".01:.07","IMP(")
;I DUZ=838 W ! ZW IMP W ! R ASD
W !
W !,"IMPORT: ",IMP(.01)
W !,"EDI : ",IMP(.03)
W !,"ERA : ",IMP(.05)
;W !,"BATCH: ",IMP(.06),?40,"ITEM: ",IMP(.07),!!
K DIR
S DIR("A")="Delete this file"
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: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)
. S XBI="" F S XBI=$O(XBFL(XBI)) Q:XBI=""!($G(X)=U) D
. . W !?5,XBI,?10,XBFL(XBI)
. . I (XBI#20) Q
. . ;;;R X:DTIME ;IM13589
. . K DIR S (X,Y)=""
. . S DIR(0)="E"
. . S DIR("A")="Hit ENTER to continue" ;ANY CHAR,
. . D ^DIR
. . K DIR
. Q
S XBFN=Y
Q
BAREDIUT ; IHS/SD/LSL - UTILITY FOR TANSPORT FILE ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,21,23**;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 ; ;P.OTT HEAT# 80621
+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^BAREDIUT(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 KILL REC
+8 DO ENP^XBDIQ1(90056.0202,"IMPDA,RECDA",".01:99","REC(")
+9 IF '$DATA(ALL)
IF REC(.02)=PRVB
SET BARQUIT=0
+10 IF '$DATA(ALL)
IF REC(.02)=PRVE
SET BARQUIT=1
+11 IF '$DATA(ALL)
IF REC(.02)=TRLB
SET BARQUIT=0
+12 IF '$DATA(ALL)
IF REC(.02)="PLB"
SET BARQUIT=0
+13 IF BARQUIT
QUIT
+14 WRITE !!,"*",REC(.02),?10,REC(.03)
+15 FOR SEQ=1:1
IF '$DATA(REC(10,SEQ))
QUIT
Begin DoDot:1
+16 IF REC(10,SEQ)=""
QUIT
+17 SET PATH=REC(.04)
+18 SET TRDA=+PATH
+19 SET SEGDA=$PIECE(PATH,",",2)
+20 SET ELMDA=$$ELMSEQDA(TRDA,SEGDA,SEQ)
+21 SET X=$$VAL^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",.02)
+22 WRITE !,$EXTRACT(X,1,25),?27,REC(10,SEQ)
End DoDot:1
+23 QUIT
+24 ; *********************************************************************
+25 ;
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 ;
STATUS() ;PREPARE STRING OF STATUSES OF CLAIMS P.OTT
+1 NEW STR,STA
+2 SET STR=""
+3 SET STA=""
FOR
SET STA=$ORDER(^BAREDI("I",DUZ(2),Y,30,"AC",STA))
IF STA=""
QUIT
SET STR=STR_STA_" "
+4 QUIT STR
DELIMP ; EP
+1 ; Delete an Import
+2 KILL DIC,DR,DA
+3 WRITE !!,"This is to delete ERA Import file",!
+4 SET DIC=90056.02
+5 SET DIC(0)="AEQM"
+6 ;P.OTT DISPLAY STATUS(ES)
SET DIC("W")="W ?35,$P(^(0),U,5),?70,$$STATUS^BAREDIUT()"
+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 ;P.OTT
IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,"AC","P"))
Begin DoDot:1
+16 WRITE !,"This file has one or more posted claims. Cannot delete."
+17 KILL DIR
+18 SET DIR("A")="hit ^ to return"
+19 SET DIR(0)="E"
+20 DO ^DIR
End DoDot:1
QUIT
+21 ;E W !,"No posted claims for this file. "
+22 KILL IMP
+23 DO ENP^XBDIQ1(90056.02,IMPDA,".01:.07","IMP(")
+24 ;I DUZ=838 W ! ZW IMP W ! R ASD
+25 WRITE !
+26 WRITE !,"IMPORT: ",IMP(.01)
+27 WRITE !,"EDI : ",IMP(.03)
+28 WRITE !,"ERA : ",IMP(.05)
+29 ;W !,"BATCH: ",IMP(.06),?40,"ITEM: ",IMP(.07),!!
+30 KILL DIR
+31 SET DIR("A")="Delete this file"
+32 SET DIR(0)="Y"
+33 SET DIR("B")="N"
+34 DO ^DIR
+35 KILL DIR
+36 IF 'Y
WRITE !!,IMP(.01)," NOT DELETED ",!
GOTO DELIMP
+37 KILL DA,DR,DIE
+38 SET DIDEL=90056.02
+39 SET DIE=$$DIC^XBDIQ1(90056.02)
+40 SET DR=".01///@"
+41 SET DA=IMPDA
+42 DO ^DIE
+43 WRITE !!,IMP(.01)," DELETED",!
+44 GOTO DELIMP
+45 ; *********************************************************************
+46 ;
FNAME ; EP
+1 ; Select a file (directory can be pre-loaded into XBDIR)
+2 KILL DIR
+3 ;
FNAME1 ;
+1 SET XBFN=""
+2 ;IM14472
SET DIR(0)="FO^1:50"
+3 SET DIR("A")="File Name "
+4 DO ^DIR
+5 KILL DIR
+6 IF $GET(DTOUT)
QUIT
+7 IF Y["^"
QUIT
+8 IF Y=""
QUIT
+9 ;IHS/SD/TPF 10/4/2011 BAR*1.8*21 ERROR DURING TESTING
IF Y=" "
QUIT
+10 IF Y?.N
IF $DATA(XBFL(Y))
SET DIR("B")=XBFL(Y)
GOTO FNAME1
+11 IF Y["*"
Begin DoDot:1
+12 KILL XBFL
+13 SET X=$$LIST^%ZISH(XBDIR,Y,.XBFL)
+14 SET XBI=""
FOR
SET XBI=$ORDER(XBFL(XBI))
IF XBI=""!($GET(X)=U)
QUIT
Begin DoDot:2
+15 WRITE !?5,XBI,?10,XBFL(XBI)
+16 IF (XBI#20)
QUIT
+17 ;;;R X:DTIME ;IM13589
+18 KILL DIR
SET (X,Y)=""
+19 SET DIR(0)="E"
+20 ;ANY CHAR,
SET DIR("A")="Hit ENTER to continue"
+21 DO ^DIR
+22 KILL DIR
End DoDot:2
+23 QUIT
End DoDot:1
GOTO FNAME
+24 SET XBFN=Y
+25 QUIT
