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

BAREDIUT.m

Go to the documentation of this file. 
  1. BAREDIUT ; IHS/SD/LSL - UTILITY FOR TANSPORT FILE ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,21,23**;OCT 26,2005
  1.  ;;
  1.  ; IHS/ASDS/LSL - 09/11/01 - V1.5 Patch 2 - NOIS CXX-0501-110014
  1.  ;     Allow deletion of ERA Import files
  1.  ;
  1.  ; IHS/SD/LSL - 09/18/03 - V1.7 Patch 4 - HIPAA
  1.  ; 
  1.  ; IHS/SD/LSL - 06/23/04 - V1.8 Patch 1 - IM13589
  1.  ;     ERA file listing not working
  1.  ;
  1.  ;IHS/SD/LSL - 08/3/04 - V1.8 Patch 1 - IM14472
  1.  ;     lengthen filename to 50 characters
  1.  ;     FIELD CROSS REFERENCE CHANGED TO 80
  1.  ;     POST ROUTINE RE-INDEXS RECORDS 
  1.  ; ;P.OTT HEAT# 80621
  1.  ; *********************************************************************
  1.  ;
  1. PRTVARA(TRDA) ; EP
  1.  ; PRINT POSTING VARIABLES BY VARIABLE NAME ALPHABETICAL
  1.  S VAR=""
  1.  F  S VAR=$O(^BAREDI("1T",TRDA,10,"D",VAR)) Q:VAR=""  D
  1.  . S SEGDA=0
  1.  . F  S SEGDA=$O(^BAREDI("1T",TRDA,10,"D",VAR,SEGDA)) Q:SEGDA'>0  D
  1.  .. S SEGNM=$$VAL^XBDIQ1(90056.0101,"TRDA,SEGDA",.01)
  1.  .. S ELMDA=0
  1.  .. F  S ELMDA=$O(^BAREDI("1T",TRDA,10,"D",VAR,SEGDA,ELMDA)) Q:ELMDA'>0  D
  1.  ... K ELM
  1.  ... D ENP^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",".01;.02","ELM(")
  1.  ... W !,VAR,?12,SEGNM,?25,ELM(.01),?35,ELM(.02)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PRTVARS(TRDA) ; EP
  1.  ; PRINT POSTING VARIABLES BY SEGMENT ORDER
  1.  S SEGNM="",SEGLNM=""
  1.  F  S SEGNM=$O(^BAREDI("1T",TRDA,10,"B",SEGNM)) Q:SEGNM=""  D
  1.  . S SEGDA=$O(^BAREDI("1T",TRDA,10,"B",SEGNM,0))
  1.  . Q:'SEGDA
  1.  . I '$D(^BAREDI("1T",TRDA,10,SEGDA,10,"C")) Q
  1.  . S SEQDA=0
  1.  . F  S SEQDA=$O(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQDA)) Q:SEQDA'>0  D
  1.  .. S ELMDA=$O(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQDA,0))
  1.  .. K ELM
  1.  .. D ENP^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",".01;.02;.08","ELM(")
  1.  .. I '$L(ELM(.08)) Q
  1.  .. W !
  1.  .. W:SEGNM'=SEGLNM SEGNM
  1.  .. W ?20,ELM(.01),?30,ELM(.02),?65,ELM(.08)
  1.  .. S SEGLNM=SEGNM
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. VIEW(TRDA,IMPDA) ; EP
  1.  ; Browse an Import
  1.  I '$G(TRDA) S TRDA=$$GET1^DIQ(90056.02,IMPDA,.03,"I")
  1.  Q:$G(TRDA)=""
  1.  Q:$G(IMPDA)=""
  1.  S BARIMP=$$GET1^DIQ(90056.02,IMPDA,.01)
  1.  D VIEWR^XBLM("PRINT^BAREDIUT(TRDA,IMPDA)","VIEW IMPORT: "_BARIMP)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. RECPRT(RECDA) ;
  1.  ; print an import record and its elements
  1.  ; note SEQ in elements 1,2,3,4 .. may not be the
  1.  ; the same as ELMDA , as SEQ=ELMDA(.03)
  1.  ; use 'ac' index to look up element by sequence
  1.  ;
  1.  ; pull in the record and converted elements
  1.  K REC
  1.  D ENP^XBDIQ1(90056.0202,"IMPDA,RECDA",".01:99","REC(")
  1.  I '$D(ALL),REC(.02)=PRVB S BARQUIT=0
  1.  I '$D(ALL),REC(.02)=PRVE S BARQUIT=1
  1.  I '$D(ALL),REC(.02)=TRLB S BARQUIT=0
  1.  I '$D(ALL),REC(.02)="PLB" S BARQUIT=0
  1.  Q:BARQUIT
  1.  W !!,"*",REC(.02),?10,REC(.03)
  1.  F SEQ=1:1 Q:'$D(REC(10,SEQ))  D
  1.  . Q:REC(10,SEQ)=""
  1.  . S PATH=REC(.04)
  1.  . S TRDA=+PATH
  1.  . S SEGDA=$P(PATH,",",2)
  1.  . S ELMDA=$$ELMSEQDA(TRDA,SEGDA,SEQ)
  1.  . S X=$$VAL^XBDIQ1(90056.0102,"TRDA,SEGDA,ELMDA",.02)
  1.  . W !,$E(X,1,25),?27,REC(10,SEQ)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PRINT(TRDA,IMPDA) ; EP
  1.  ; Print records of import IMPDA
  1.  Q:$G(TRDA)=""
  1.  Q:$G(IMPDA)=""
  1.  I 'TRDA S TRDA=$$GET1^DIQ(90056.02,IMPDA,.03,"I")
  1.  Q:$G(TRDA)=""
  1.  K ^TMP($J,"REC")
  1.  ; pull provider start & end records
  1.  K TR
  1.  D ENP^XBDIQ1(90056.01,TRDA,".04;.05;.06","TR(")
  1.  S PRVB=TR(.04)
  1.  S PRVE=TR(.05)
  1.  S TRLB=TR(.06)
  1.  S BARQUIT=0
  1.  D ENPM^XBDIQ1(90056.0202,"IMPDA,0",.01,"^TMP($J,""REC"",")
  1.  S RECDA=0
  1.  F  S RECDA=$O(^TMP($J,"REC",RECDA)) Q:RECDA'>0  D RECPRT(RECDA)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. ELMSEQDA(TRDA,SEGDA,SEQ) ; EP
  1.  ; return ELMDA given TRDA,SEGDA, SEQ
  1.  N X
  1.  S X=$O(^BAREDI("1T",TRDA,10,SEGDA,10,"AC",SEQ,0))
  1.  ;
  1. END ;
  1.  Q X
  1.  ; *********************************************************************
  1.  ;
  1. CLAIMS(IMPDA) ; EP
  1.  ; Print the Claims in a transport for posting
  1.  S CLMDA=0
  1.  F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:CLMDA'>0  D
  1.  . K CLM
  1.  . D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01:.09","CLM(")
  1.  . K ADJ
  1.  . D ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".01:.05","ADJ(")
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. STRIP(XX) ; EP
  1.  ; Strip training spaces
  1.  N L S L=$L(XX)
  1.  F I=L:-1:1 S X=$E(XX,I) Q:X'=" "  S XX=$E(XX,1,I-1)
  1.  Q XX
  1.  ; *********************************************************************
  1.  ;
  1. STATUS() ;PREPARE STRING OF STATUSES OF CLAIMS P.OTT
  1.  NEW STR,STA
  1.  S STR=""
  1.  S STA="" F  S STA=$O(^BAREDI("I",DUZ(2),Y,30,"AC",STA)) Q:STA=""  S STR=STR_STA_" "
  1.  QUIT STR
  1. DELIMP ; EP
  1.  ; Delete an Import
  1.  K DIC,DR,DA
  1.  W !!,"This is to delete ERA Import file",!
  1.  S DIC=90056.02
  1.  S DIC(0)="AEQM"
  1.  S DIC("W")="W ?35,$P(^(0),U,5),?70,$$STATUS^BAREDIUT()" ;P.OTT DISPLAY STATUS(ES)
  1.  D ^DIC
  1.  I Y'>0 D  Q
  1.  . W !!,"None Chosen",!
  1.  . K DIR
  1.  . S DIR("A")="<CR> - Continue"
  1.  . S DIR(0)="E"
  1.  . D ^DIR
  1.  S IMPDA=+Y
  1.  I $D(^BAREDI("I",DUZ(2),IMPDA,30,"AC","P")) D  QUIT  ;P.OTT
  1.  . W !,"This file has one or more posted claims. Cannot delete."
  1.  . K DIR
  1.  . S DIR("A")="hit ^ to return"
  1.  . S DIR(0)="E"
  1.  . D ^DIR
  1.  ;E  W !,"No posted claims for this file. "
  1.  K IMP
  1.  D ENP^XBDIQ1(90056.02,IMPDA,".01:.07","IMP(")
  1.  ;I DUZ=838 W ! ZW IMP W ! R ASD
  1.  W !
  1.  W !,"IMPORT: ",IMP(.01)
  1.  W !,"EDI   : ",IMP(.03)
  1.  W !,"ERA   : ",IMP(.05)
  1.  ;W !,"BATCH: ",IMP(.06),?40,"ITEM: ",IMP(.07),!!
  1.  K DIR
  1.  S DIR("A")="Delete this file"
  1.  S DIR(0)="Y"
  1.  S DIR("B")="N"
  1.  D ^DIR
  1.  K DIR
  1.  I 'Y W !!,IMP(.01),"   NOT DELETED  ",! G DELIMP
  1.  K DA,DR,DIE
  1.  S DIDEL=90056.02
  1.  S DIE=$$DIC^XBDIQ1(90056.02)
  1.  S DR=".01///@"
  1.  S DA=IMPDA
  1.  D ^DIE
  1.  W !!,IMP(.01),"   DELETED",!
  1.  G DELIMP
  1.  ; *********************************************************************
  1.  ;
  1. FNAME ; EP
  1.  ; Select a file (directory can be pre-loaded into XBDIR)
  1.  K DIR
  1.  ;
  1. FNAME1 ;
  1.  S XBFN=""
  1.  S DIR(0)="FO^1:50"               ;IM14472
  1.  S DIR("A")="File Name "
  1.  D ^DIR
  1.  K DIR
  1.  Q:$G(DTOUT)
  1.  Q:Y["^"
  1.  Q:Y=""
  1.  Q:Y=" "  ;IHS/SD/TPF 10/4/2011 BAR*1.8*21 ERROR DURING TESTING
  1.  I Y?.N,$D(XBFL(Y)) S DIR("B")=XBFL(Y) G FNAME1
  1.  I Y["*" D  G FNAME
  1.  . K XBFL
  1.  . S X=$$LIST^%ZISH(XBDIR,Y,.XBFL)
  1.  . S XBI="" F  S XBI=$O(XBFL(XBI)) Q:XBI=""!($G(X)=U)  D
  1.  . . W !?5,XBI,?10,XBFL(XBI)
  1.  . . I (XBI#20) Q
  1.  . . ;;;R X:DTIME  ;IM13589
  1.  . . K DIR S (X,Y)=""
  1.  . . S DIR(0)="E"
  1.  . . S DIR("A")="Hit ENTER to continue" ;ANY CHAR, 
  1.  . . D ^DIR
  1.  . . K DIR
  1.  . Q
  1.  S XBFN=Y
  1.  Q