BAREDLA1 ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
D CLEAR^VALM1
;
EN(DLFL) ;EP -- for the file type
;Called from BAREDLA1
S FILE=DLFL
D EN^VALM("BAR TOP LEVEL FILES")
Q
; *********************************************************************
;
HDR ;EP -- header code
S VALMSG=$$VALMSG^AMCOUT
S VALMHDR(1)=$P($G(^BAREDI("1T",FILE,0)),"^")
Q
; *********************************************************************
;
INIT ;EP -- init variables and list array
D GATHER
S VALMCNT=20
Q
; *********************************************************************
;
HELP ;EP -- help code
S X="?"
D DISP^XQORM1
D MSG^AMCOUT("",2,0,0)
Q
; *********************************************************************
;
EXIT ;EP -- exit code
D CLEAR^VALM1
Q
; *********************************************************************
;
EXPND ;EP -- expand code
Q
; *********************************************************************
;
RESET ;EP; -- rebuilds array after action
D TERM^VALM0
S VALMBCK="R"
D INIT,HDR
Q
; *********************************************************************
;
GATHER ; -- SUBRTN to set data into array
;
;Created in BAREDLA1, specific to each FILE#
;S LST=$G(^TMP($J,"FILE"))
;
; List of Files to be accessed
;
S FLST="0101^0103^0105^0107"
S FLD="Segment^Data Types^Tables^Claim Level Reason Codes"
K ^TMP($J,"LVL0")
K LVL0
S RECNM=0
S (LN,COUNT)=1
;
;Get file details
S (SFL,LNC)=1
F S SFL=$O(^BAREDI("1T",FILE,SFL)) Q:SFL="" D
. S CURRENT=0
. S FLN=$P($G(^BAREDI("1T",FILE,SFL,0)),U,2)
. F I=1:1:4 I FLN[($P(FLST,U,I)) S FD=$P(FLD,U,I),CURRENT=1
. Q:'CURRENT
. S LVL0($J,SFL,I)=FD
. S ^TMP($J,"L0",LNC)=FLN_U_FD
. S LNC=LNC+1
;
S RN=""
F S RN=$O(LVL0($J,RN)) Q:RN="" D
. S (RECORD,DI)=""
. F S DI=$O(LVL0($J,RN,DI)) Q:DI="" D
..S FLEN=40
..S FIELD=$G(LVL0($J,RN,DI))
..S RECORD=RECORD_$$PAD(FIELD,FLEN)
.S ^TMP($J,"LVL0",LN,0)=$$PAD(LN,3)_RECORD
.S ^TMP($J,"LVL0","IDX",LN,LN)=""
.S LN=LN+1,COUNT=COUNT+1
Q
; *********************************************************************
;
GETITEM ;
;
K HDR
S VALMLST=""
S VALMLST=$O(^TMP($J,"LVL0","IDX",VALMLST),-1)
D EN^VALM2(XQORNOD(0),"O")
I '$D(VALMY) Q
NEW X,Y
S X=0
F S X=$O(VALMY(X)) Q:X="" D
. S HDR=$E($P($G(^TMP($J,"L0",X)),U),1,10)
. S FD=$P($G(^TMP($J,"L0",X)),U,2)
Q
; *********************************************************************
;
BROWSE ; Get specifc details for SEGMENTS, DATA TYPES etc.
;
D GETITEM I '$D(HDR) Q
D EN^BAREDL01(HDR,FD)
Q
; *********************************************************************
;
PAD(D,L) ; -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
; *********************************************************************
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BAREDLA1 ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 DO CLEAR^VALM1
+4 ;
EN(DLFL) ;EP -- for the file type
+1 ;Called from BAREDLA1
+2 SET FILE=DLFL
+3 DO EN^VALM("BAR TOP LEVEL FILES")
+4 QUIT
+5 ; *********************************************************************
+6 ;
HDR ;EP -- header code
+1 SET VALMSG=$$VALMSG^AMCOUT
+2 SET VALMHDR(1)=$PIECE($GET(^BAREDI("1T",FILE,0)),"^")
+3 QUIT
+4 ; *********************************************************************
+5 ;
INIT ;EP -- init variables and list array
+1 DO GATHER
+2 SET VALMCNT=20
+3 QUIT
+4 ; *********************************************************************
+5 ;
HELP ;EP -- help code
+1 SET X="?"
+2 DO DISP^XQORM1
+3 DO MSG^AMCOUT("",2,0,0)
+4 QUIT
+5 ; *********************************************************************
+6 ;
EXIT ;EP -- exit code
+1 DO CLEAR^VALM1
+2 QUIT
+3 ; *********************************************************************
+4 ;
EXPND ;EP -- expand code
+1 QUIT
+2 ; *********************************************************************
+3 ;
RESET ;EP; -- rebuilds array after action
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
DO HDR
+4 QUIT
+5 ; *********************************************************************
+6 ;
GATHER ; -- SUBRTN to set data into array
+1 ;
+2 ;Created in BAREDLA1, specific to each FILE#
+3 ;S LST=$G(^TMP($J,"FILE"))
+4 ;
+5 ; List of Files to be accessed
+6 ;
+7 SET FLST="0101^0103^0105^0107"
+8 SET FLD="Segment^Data Types^Tables^Claim Level Reason Codes"
+9 KILL ^TMP($JOB,"LVL0")
+10 KILL LVL0
+11 SET RECNM=0
+12 SET (LN,COUNT)=1
+13 ;
+14 ;Get file details
+15 SET (SFL,LNC)=1
+16 FOR
SET SFL=$ORDER(^BAREDI("1T",FILE,SFL))
IF SFL=""
QUIT
Begin DoDot:1
+17 SET CURRENT=0
+18 SET FLN=$PIECE($GET(^BAREDI("1T",FILE,SFL,0)),U,2)
+19 FOR I=1:1:4
IF FLN[($PIECE(FLST,U,I))
SET FD=$PIECE(FLD,U,I)
SET CURRENT=1
+20 IF 'CURRENT
QUIT
+21 SET LVL0($JOB,SFL,I)=FD
+22 SET ^TMP($JOB,"L0",LNC)=FLN_U_FD
+23 SET LNC=LNC+1
End DoDot:1
+24 ;
+25 SET RN=""
+26 FOR
SET RN=$ORDER(LVL0($JOB,RN))
IF RN=""
QUIT
Begin DoDot:1
+27 SET (RECORD,DI)=""
+28 FOR
SET DI=$ORDER(LVL0($JOB,RN,DI))
IF DI=""
QUIT
Begin DoDot:2
+29 SET FLEN=40
+30 SET FIELD=$GET(LVL0($JOB,RN,DI))
+31 SET RECORD=RECORD_$$PAD(FIELD,FLEN)
End DoDot:2
+32 SET ^TMP($JOB,"LVL0",LN,0)=$$PAD(LN,3)_RECORD
+33 SET ^TMP($JOB,"LVL0","IDX",LN,LN)=""
+34 SET LN=LN+1
SET COUNT=COUNT+1
End DoDot:1
+35 QUIT
+36 ; *********************************************************************
+37 ;
GETITEM ;
+1 ;
+2 KILL HDR
+3 SET VALMLST=""
+4 SET VALMLST=$ORDER(^TMP($JOB,"LVL0","IDX",VALMLST),-1)
+5 DO EN^VALM2(XQORNOD(0),"O")
+6 IF '$DATA(VALMY)
QUIT
+7 NEW X,Y
+8 SET X=0
+9 FOR
SET X=$ORDER(VALMY(X))
IF X=""
QUIT
Begin DoDot:1
+10 SET HDR=$EXTRACT($PIECE($GET(^TMP($JOB,"L0",X)),U),1,10)
+11 SET FD=$PIECE($GET(^TMP($JOB,"L0",X)),U,2)
End DoDot:1
+12 QUIT
+13 ; *********************************************************************
+14 ;
BROWSE ; Get specifc details for SEGMENTS, DATA TYPES etc.
+1 ;
+2 DO GETITEM
IF '$DATA(HDR)
QUIT
+3 DO EN^BAREDL01(HDR,FD)
+4 QUIT
+5 ; *********************************************************************
+6 ;
PAD(D,L) ; -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ; *********************************************************************
+4 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
