BAREDL01 ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
D CLEAR^VALM1
;
EN(FLNM,FD) ;EP
; -- for the file type
;Called from BAREDLA1
K ^TMP($J,"LVL1")
S FLNUM=FLNM
D EN^VALM("BAR "_FD)
Q
; *********************************************************************
;
HDR ;EP -- header code
S VALMSG=$$VALMSG^AMCOUT
S VALMHDR(1)=$P($G(^BAREDI("1T",FILE,0)),"^")
S VALMHDR(2)=FD
Q
; *********************************************************************
;
INIT ;EP -- init variables and list array
D GATHER(FLNUM)
S VALMCNT=35
Q
; *********************************************************************
;
HELP ;EP -- help code
S X="?"
D DISP^XQORM1,MSG^AMCOUT("",2,0,0)
Q
; *********************************************************************
;
EXIT ;EP -- exit code
D CLEAR^VALM1
K ^TMP($J,"LVL1")
Q
; *********************************************************************
;
EXPND ;EP -- expand code
Q
; *********************************************************************
;
RESET ;EP; -- rebuilds array after action
D TERM^VALM0
S VALMBCK="R"
D INIT,HDR
Q
; *********************************************************************
;
GATHER(FLNUM) ; -- SUBRTN to set data into array
;
;Created in BAREDLA1, specific to each FILE#
;For testing
S LST=".01;.03"
;
K ^TMP($J,"FD"),^TMP($J,"FL")
K ^TMP($J,"LVL1"),^TMP($J,"LVL2")
K SEG
S ARSUB="1,1,0"
S RECNM=0
S (LN,COUNT)=1
;
;
;Get file details
D ENPM^XBDIQ1(FLNUM,ARSUB,LST,"SEG($J,")
;
S RN=""
F S RN=$O(SEG($J,RN)) Q:RN="" D
. S (RECORD,DI)=""
. F S DI=$O(SEG($J,RN,DI)) Q:DI="" D
..S FLEN=25
. .S FIELD=$G(SEG($J,RN,DI))
..I $L(FIELD)<15 S FLEN=15
.. S RECORD=RECORD_$$PAD(FIELD,FLEN)
.S ^TMP($J,"FD",LN)=RECORD
.S ^TMP($J,"LVL1",LN,0)=$$PAD(LN,3)_RECORD
.S ^TMP($J,"LVL1","IDX",LN,LN)=""
.S LN=LN+1,COUNT=COUNT+1
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)
BAREDL01 ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 DO CLEAR^VALM1
+4 ;
EN(FLNM,FD) ;EP
+1 ; -- for the file type
+2 ;Called from BAREDLA1
+3 KILL ^TMP($JOB,"LVL1")
+4 SET FLNUM=FLNM
+5 DO EN^VALM("BAR "_FD)
+6 QUIT
+7 ; *********************************************************************
+8 ;
HDR ;EP -- header code
+1 SET VALMSG=$$VALMSG^AMCOUT
+2 SET VALMHDR(1)=$PIECE($GET(^BAREDI("1T",FILE,0)),"^")
+3 SET VALMHDR(2)=FD
+4 QUIT
+5 ; *********************************************************************
+6 ;
INIT ;EP -- init variables and list array
+1 DO GATHER(FLNUM)
+2 SET VALMCNT=35
+3 QUIT
+4 ; *********************************************************************
+5 ;
HELP ;EP -- help code
+1 SET X="?"
+2 DO DISP^XQORM1
DO MSG^AMCOUT("",2,0,0)
+3 QUIT
+4 ; *********************************************************************
+5 ;
EXIT ;EP -- exit code
+1 DO CLEAR^VALM1
+2 KILL ^TMP($JOB,"LVL1")
+3 QUIT
+4 ; *********************************************************************
+5 ;
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(FLNUM) ; -- SUBRTN to set data into array
+1 ;
+2 ;Created in BAREDLA1, specific to each FILE#
+3 ;For testing
+4 SET LST=".01;.03"
+5 ;
+6 KILL ^TMP($JOB,"FD"),^TMP($JOB,"FL")
+7 KILL ^TMP($JOB,"LVL1"),^TMP($JOB,"LVL2")
+8 KILL SEG
+9 SET ARSUB="1,1,0"
+10 SET RECNM=0
+11 SET (LN,COUNT)=1
+12 ;
+13 ;
+14 ;Get file details
+15 DO ENPM^XBDIQ1(FLNUM,ARSUB,LST,"SEG($J,")
+16 ;
+17 SET RN=""
+18 FOR
SET RN=$ORDER(SEG($JOB,RN))
IF RN=""
QUIT
Begin DoDot:1
+19 SET (RECORD,DI)=""
+20 FOR
SET DI=$ORDER(SEG($JOB,RN,DI))
IF DI=""
QUIT
Begin DoDot:2
+21 SET FLEN=25
+22 SET FIELD=$GET(SEG($JOB,RN,DI))
+23 IF $LENGTH(FIELD)<15
SET FLEN=15
+24 SET RECORD=RECORD_$$PAD(FIELD,FLEN)
End DoDot:2
+25 SET ^TMP($JOB,"FD",LN)=RECORD
+26 SET ^TMP($JOB,"LVL1",LN,0)=$$PAD(LN,3)_RECORD
+27 SET ^TMP($JOB,"LVL1","IDX",LN,LN)=""
+28 SET LN=LN+1
SET COUNT=COUNT+1
End DoDot:1
+29 QUIT
+30 ; *********************************************************************
+31 ;
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)
