BAREDLA1.m

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)