- BAR500Z ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
- ;;1.8;IHS ACCOUNTS RECEIVABLE**21**;;OCT 26, 2005
- ;
- D CLEAR^VALM1
- EN ;Entry point
- ;
- W #
- S Y=$$SELTRAN^BAR50I01
- Q:Y'>0
- ;
- S DLFL=Y
- ;
- D ENTRY(DLFL)
- Q
- ; *********************************************************************
- ;
- ENTRY(DLFL) ;Entry point for the file type
- S FILE=DLFL
- D EN^VALM("BAR ERA Maintenance")
- 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,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
- ;
- ; List of Routines to be accessed
- ;
- S DL="/"
- S FLST="EDTSEG^BAR50I01/EDTELEM^BAR50I01/EDTTAB^BAR50I01/"
- S FLST=FLST_"EDTCLAIM^BAR50I01/EDTDATA^BAR50I01/VIEWR^XBLM(""PRTVARS^BAREDIUT(FILE)"")"
- S FLD="Add/Edit Segment^Add/Edit Elements^Add/Edit Tables^Add/Edit Claim Level Reason Codes^Add/Edit Data Types^Reports"
- K ^TMP($J,"LVL0")
- K LVL0
- S RECNM=0
- S (LN,COUNT)=1
- ;
- ;Get file details
- S (SFL,LNC)=1
- F I=1:1:6 D
- . S FD=$P(FLD,U,I)
- . S LVL0($J,I)=FD
- . S ^TMP($J,"L0",LNC)=I_U_FD
- . S LNC=LNC+1
- ;
- S RN=""
- F S RN=$O(LVL0($J,RN)) Q:RN="" D
- . S (RECORD,DI)=""
- .S FLEN=40
- .S FIELD=$G(LVL0($J,RN))
- .S 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
- N X,Y
- S X=0
- F S X=$O(VALMY(X)) Q:X="" D
- . S HDR=$P($G(^TMP($J,"L0",X)),U,2)
- . S FN=$P($G(^TMP($J,"L0",X)),U,1)
- . S OPT=$P(FLST,DL,FN)
- Q
- ; *********************************************************************
- ;
- BROWSE ; Get specifc details for SEGMENTS, DATA TYPES etc.
- ;
- D GETITEM I '$D(HDR) Q
- D @OPT
- 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)
- BAR500Z ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE**21**;;OCT 26, 2005
- +2 ;
- +3 DO CLEAR^VALM1
- EN ;Entry point
- +1 ;
- +2 WRITE #
- +3 SET Y=$$SELTRAN^BAR50I01
- +4 IF Y'>0
- QUIT
- +5 ;
- +6 SET DLFL=Y
- +7 ;
- +8 DO ENTRY(DLFL)
- +9 QUIT
- +10 ; *********************************************************************
- +11 ;
- ENTRY(DLFL) ;Entry point for the file type
- +1 SET FILE=DLFL
- +2 DO EN^VALM("BAR ERA Maintenance")
- +3 QUIT
- +4 ; *********************************************************************
- +5 ;
- 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="?"
- DO DISP^XQORM1
- DO MSG^AMCOUT("",2,0,0)
- +2 QUIT
- +3 ; *********************************************************************
- +4 ;
- 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
- SET VALMBCK="R"
- +2 DO INIT
- DO HDR
- +3 QUIT
- +4 ; *********************************************************************
- +5 ;
- GATHER ; -- SUBRTN to set data into array
- +1 ;
- +2 ; List of Routines to be accessed
- +3 ;
- +4 SET DL="/"
- +5 SET FLST="EDTSEG^BAR50I01/EDTELEM^BAR50I01/EDTTAB^BAR50I01/"
- +6 SET FLST=FLST_"EDTCLAIM^BAR50I01/EDTDATA^BAR50I01/VIEWR^XBLM(""PRTVARS^BAREDIUT(FILE)"")"
- +7 SET FLD="Add/Edit Segment^Add/Edit Elements^Add/Edit Tables^Add/Edit Claim Level Reason Codes^Add/Edit Data Types^Reports"
- +8 KILL ^TMP($JOB,"LVL0")
- +9 KILL LVL0
- +10 SET RECNM=0
- +11 SET (LN,COUNT)=1
- +12 ;
- +13 ;Get file details
- +14 SET (SFL,LNC)=1
- +15 FOR I=1:1:6
- Begin DoDot:1
- +16 SET FD=$PIECE(FLD,U,I)
- +17 SET LVL0($JOB,I)=FD
- +18 SET ^TMP($JOB,"L0",LNC)=I_U_FD
- +19 SET LNC=LNC+1
- End DoDot:1
- +20 ;
- +21 SET RN=""
- +22 FOR
- SET RN=$ORDER(LVL0($JOB,RN))
- IF RN=""
- QUIT
- Begin DoDot:1
- +23 SET (RECORD,DI)=""
- +24 SET FLEN=40
- +25 SET FIELD=$GET(LVL0($JOB,RN))
- +26 SET RECORD=$$PAD(FIELD,FLEN)
- +27 SET ^TMP($JOB,"LVL0",LN,0)=$$PAD(LN,3)_RECORD
- +28 SET ^TMP($JOB,"LVL0","IDX",LN,LN)=""
- +29 SET LN=LN+1
- SET COUNT=COUNT+1
- End DoDot:1
- +30 QUIT
- +31 ; *********************************************************************
- +32 ;
- 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=$PIECE($GET(^TMP($JOB,"L0",X)),U,2)
- +11 SET FN=$PIECE($GET(^TMP($JOB,"L0",X)),U,1)
- +12 SET OPT=$PIECE(FLST,DL,FN)
- End DoDot:1
- +13 QUIT
- +14 ; *********************************************************************
- +15 ;
- BROWSE ; Get specifc details for SEGMENTS, DATA TYPES etc.
- +1 ;
- +2 DO GETITEM
- IF '$DATA(HDR)
- QUIT
- +3 DO @OPT
- +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)