BARED0Z ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
D CLEAR^VALM1
EN ;Entry point
;
W #
S Y=$$SELTRAN^BAREDI01
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^BAREDI01/EDTELEM^BAREDI01/EDTTAB^BAREDI01/"
S FLST=FLST_"EDTCLAIM^BAREDI01/EDTDATA^BAREDI01/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)
BARED0Z ; IHS/SD/LSL - AR TOP LEVEL FILE STRUCTURE ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 DO CLEAR^VALM1
EN ;Entry point
+1 ;
+2 WRITE #
+3 SET Y=$$SELTRAN^BAREDI01
+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^BAREDI01/EDTELEM^BAREDI01/EDTTAB^BAREDI01/"
+6 SET FLST=FLST_"EDTCLAIM^BAREDI01/EDTDATA^BAREDI01/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)
