- BAR50L01 ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
- ;;1.8;IHS ACCOUNTS RECEIVABLE;**21**;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)
- BAR50L01 ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**21**;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)