- DDXPLIB ;SFISC/DPC-EXPORT LIBRARY ;1/25/93 13:05
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- FLDNM(DDXPXTNO) ;
- N %D,%I,FLD,NAMELST,NAME
- S NAMELST=""
- S %D=$P($G(^DIST(.44,+$G(^DIPT(DDXPXTNO,105)),0)),U,2)
- S %D=$$BLDELIM^DDXP3(%D)
- S %D=$C(%D),FLD=0
- F %I=0:1 S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1 D
- . S NAME=$P(^DIPT(DDXPXTNO,100,FLD,0),U,4)
- . S NAMELST=NAMELST_NAME_%D
- . Q
- S NAMELST=$P(NAMELST,%D,1,%I)
- Q NAMELST
- ;
- DP123(DDXPXTNO) ;
- N FLD,FLDZO,DPLN,I,DT,LEN,DTCHAR
- S DPLN=""
- F FLD=0:0 S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1 S FLDZO=^(FLD,0) D
- . S DT=$P(FLDZO,U,2)
- . S LEN=$P(FLDZO,U,3)
- . S DTCHAR=$S(DT=4:"L",DT=2:"V",DT=1:"D",1:"L")
- . S DPLN=DPLN_DTCHAR
- . F I=1:1:LEN-1 S DPLN=DPLN_">"
- . Q
- Q DPLN
- ;
- DPXCEL(DDXPXTNO) ;
- N DPLN,FLD,FLDZO,LEN,I
- S DPLN=""
- F FLD=0:0 S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1 S FLDZO=^(FLD,0) D
- . S LEN=$P(FLDZO,U,3)
- . S DPLN=DPLN_"|"
- . F I=1:1:LEN-1 S DPLN=DPLN_" "
- . Q
- Q DPLN
- ;
- SASCOL ;
- N INPUTLN,FLD,NAME,DTYPE,DTYPEFOR,START,END,LENGTH,FLD0
- S INPUTLN="INPUT ",START=1,FLD=0
- F S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1 S FLD0=^(FLD,0) D
- . S NAME=$P(FLD0,U,4)_" ",LENGTH=$P(FLD0,U,3),DTYPE=$P(FLD0,U,2)
- . S DTYPEFOR=$S(DTYPE=4:"$ ",DTYPE=1:"YYMMDD"_LENGTH_". ",1:"")
- . S END=START+LENGTH-1
- . S INPUTLN=INPUTLN_NAME_DTYPEFOR_$S(DTYPE=1:"",1:START_"-"_END_" ")
- . S START=END+1
- . Q
- S INPUTLN=$E(INPUTLN,1,$L(INPUTLN)-1)_";"
- W INPUTLN,!,"CARDS;"
- Q
- ;
- ORACTL ;
- N FLD,FLD0,DELIM,NAME,LENGTH,DTYPEFRM,END,START,POS
- S FLD=0,DELIM=$P(^DIST(.44,DDXPFFNO,0),U,2),START=1,POS=""
- W "LOAD DATA",!
- W "INFILE *",!
- W "APPEND",!
- W "INTO TABLE "_$TR($P(^DIPT(DDXPXTNO,0),U,1)," ","_"),!
- W:DELIM]"" "FIELDS TERMINATED BY '"_DELIM_"' OPTIONALLY ENCLOSED BY '""'",!
- W "("
- F S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1 W:FLD>1 ",",! S FLD0=^(FLD,0) D
- . S NAME=$P(FLD0,U,4)_" ",LENGTH=$P(FLD0,U,3)
- . S DTYPEFRM=$S($P(FLD0,U,2)=1:" DATE 'MON DD,YYYY'",1:"")
- . I LENGTH>0 D
- . . S END=START+LENGTH-1
- . . S POS="POSITION ("_START_":"_END_")"
- . . S START=END+1
- . . Q
- . W NAME_POS_DTYPEFRM
- W " )",!
- W "BEGINDATA",!
- Q
- DDXPLIB ;SFISC/DPC-EXPORT LIBRARY ;1/25/93 13:05
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- FLDNM(DDXPXTNO) ;
- +1 NEW %D,%I,FLD,NAMELST,NAME
- +2 SET NAMELST=""
- +3 SET %D=$PIECE($GET(^DIST(.44,+$GET(^DIPT(DDXPXTNO,105)),0)),U,2)
- +4 SET %D=$$BLDELIM^DDXP3(%D)
- +5 SET %D=$CHAR(%D)
- SET FLD=0
- +6 FOR %I=0:1
- SET FLD=$ORDER(^DIPT(DDXPXTNO,100,FLD))
- IF FLD<1
- QUIT
- Begin DoDot:1
- +7 SET NAME=$PIECE(^DIPT(DDXPXTNO,100,FLD,0),U,4)
- +8 SET NAMELST=NAMELST_NAME_%D
- +9 QUIT
- End DoDot:1
- +10 SET NAMELST=$PIECE(NAMELST,%D,1,%I)
- +11 QUIT NAMELST
- +12 ;
- DP123(DDXPXTNO) ;
- +1 NEW FLD,FLDZO,DPLN,I,DT,LEN,DTCHAR
- +2 SET DPLN=""
- +3 FOR FLD=0:0
- SET FLD=$ORDER(^DIPT(DDXPXTNO,100,FLD))
- IF FLD<1
- QUIT
- SET FLDZO=^(FLD,0)
- Begin DoDot:1
- +4 SET DT=$PIECE(FLDZO,U,2)
- +5 SET LEN=$PIECE(FLDZO,U,3)
- +6 SET DTCHAR=$SELECT(DT=4:"L",DT=2:"V",DT=1:"D",1:"L")
- +7 SET DPLN=DPLN_DTCHAR
- +8 FOR I=1:1:LEN-1
- SET DPLN=DPLN_">"
- +9 QUIT
- End DoDot:1
- +10 QUIT DPLN
- +11 ;
- DPXCEL(DDXPXTNO) ;
- +1 NEW DPLN,FLD,FLDZO,LEN,I
- +2 SET DPLN=""
- +3 FOR FLD=0:0
- SET FLD=$ORDER(^DIPT(DDXPXTNO,100,FLD))
- IF FLD<1
- QUIT
- SET FLDZO=^(FLD,0)
- Begin DoDot:1
- +4 SET LEN=$PIECE(FLDZO,U,3)
- +5 SET DPLN=DPLN_"|"
- +6 FOR I=1:1:LEN-1
- SET DPLN=DPLN_" "
- +7 QUIT
- End DoDot:1
- +8 QUIT DPLN
- +9 ;
- SASCOL ;
- +1 NEW INPUTLN,FLD,NAME,DTYPE,DTYPEFOR,START,END,LENGTH,FLD0
- +2 SET INPUTLN="INPUT "
- SET START=1
- SET FLD=0
- +3 FOR
- SET FLD=$ORDER(^DIPT(DDXPXTNO,100,FLD))
- IF FLD<1
- QUIT
- SET FLD0=^(FLD,0)
- Begin DoDot:1
- +4 SET NAME=$PIECE(FLD0,U,4)_" "
- SET LENGTH=$PIECE(FLD0,U,3)
- SET DTYPE=$PIECE(FLD0,U,2)
- +5 SET DTYPEFOR=$SELECT(DTYPE=4:"$ ",DTYPE=1:"YYMMDD"_LENGTH_". ",1:"")
- +6 SET END=START+LENGTH-1
- +7 SET INPUTLN=INPUTLN_NAME_DTYPEFOR_$SELECT(DTYPE=1:"",1:START_"-"_END_" ")
- +8 SET START=END+1
- +9 QUIT
- End DoDot:1
- +10 SET INPUTLN=$EXTRACT(INPUTLN,1,$LENGTH(INPUTLN)-1)_";"
- +11 WRITE INPUTLN,!,"CARDS;"
- +12 QUIT
- +13 ;
- ORACTL ;
- +1 NEW FLD,FLD0,DELIM,NAME,LENGTH,DTYPEFRM,END,START,POS
- +2 SET FLD=0
- SET DELIM=$PIECE(^DIST(.44,DDXPFFNO,0),U,2)
- SET START=1
- SET POS=""
- +3 WRITE "LOAD DATA",!
- +4 WRITE "INFILE *",!
- +5 WRITE "APPEND",!
- +6 WRITE "INTO TABLE "_$TRANSLATE($PIECE(^DIPT(DDXPXTNO,0),U,1)," ","_"),!
- +7 IF DELIM]""
- WRITE "FIELDS TERMINATED BY '"_DELIM_"' OPTIONALLY ENCLOSED BY '""'",!
- +8 WRITE "("
- +9 FOR
- SET FLD=$ORDER(^DIPT(DDXPXTNO,100,FLD))
- IF FLD<1
- QUIT
- IF FLD>1
- WRITE ",",!
- SET FLD0=^(FLD,0)
- Begin DoDot:1
- +10 SET NAME=$PIECE(FLD0,U,4)_" "
- SET LENGTH=$PIECE(FLD0,U,3)
- +11 SET DTYPEFRM=$SELECT($PIECE(FLD0,U,2)=1:" DATE 'MON DD,YYYY'",1:"")
- +12 IF LENGTH>0
- Begin DoDot:2
- +13 SET END=START+LENGTH-1
- +14 SET POS="POSITION ("_START_":"_END_")"
- +15 SET START=END+1
- +16 QUIT
- End DoDot:2
- +17 WRITE NAME_POS_DTYPEFRM
- End DoDot:1
- +18 WRITE " )",!
- +19 WRITE "BEGINDATA",!
- +20 QUIT
