File:  [Coherent Logic Development] / freem_fileman / USER / DDXPLIB.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDXPLIB	;SFISC/DPC-EXPORT LIBRARY ;1/25/93  13:05
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: FLDNM(DDXPXTNO)	;
    5: 	N %D,%I,FLD,NAMELST,NAME
    6: 	S NAMELST=""
    7: 	S %D=$P($G(^DIST(.44,+$G(^DIPT(DDXPXTNO,105)),0)),U,2)
    8: 	S %D=$$BLDELIM^DDXP3(%D)
    9: 	S %D=$C(%D),FLD=0
   10: 	F %I=0:1 S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1  D
   11: 	. S NAME=$P(^DIPT(DDXPXTNO,100,FLD,0),U,4)
   12: 	. S NAMELST=NAMELST_NAME_%D
   13: 	. Q
   14: 	S NAMELST=$P(NAMELST,%D,1,%I)
   15: 	Q NAMELST
   16: 	;
   17: DP123(DDXPXTNO)	;
   18: 	N FLD,FLDZO,DPLN,I,DT,LEN,DTCHAR
   19: 	S DPLN=""
   20: 	F FLD=0:0 S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1  S FLDZO=^(FLD,0) D
   21: 	. S DT=$P(FLDZO,U,2)
   22: 	. S LEN=$P(FLDZO,U,3)
   23: 	. S DTCHAR=$S(DT=4:"L",DT=2:"V",DT=1:"D",1:"L")
   24: 	. S DPLN=DPLN_DTCHAR
   25: 	. F I=1:1:LEN-1 S DPLN=DPLN_">"
   26: 	. Q
   27: 	Q DPLN
   28: 	;
   29: DPXCEL(DDXPXTNO)	;
   30: 	N DPLN,FLD,FLDZO,LEN,I
   31: 	S DPLN=""
   32: 	F FLD=0:0 S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1  S FLDZO=^(FLD,0) D
   33: 	. S LEN=$P(FLDZO,U,3)
   34: 	. S DPLN=DPLN_"|"
   35: 	. F I=1:1:LEN-1 S DPLN=DPLN_" "
   36: 	. Q
   37: 	Q DPLN
   38: 	;
   39: SASCOL	;
   40: 	N INPUTLN,FLD,NAME,DTYPE,DTYPEFOR,START,END,LENGTH,FLD0
   41: 	S INPUTLN="INPUT ",START=1,FLD=0
   42: 	F  S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1  S FLD0=^(FLD,0) D
   43: 	. S NAME=$P(FLD0,U,4)_" ",LENGTH=$P(FLD0,U,3),DTYPE=$P(FLD0,U,2)
   44: 	. S DTYPEFOR=$S(DTYPE=4:"$ ",DTYPE=1:"YYMMDD"_LENGTH_". ",1:"")
   45: 	. S END=START+LENGTH-1
   46: 	. S INPUTLN=INPUTLN_NAME_DTYPEFOR_$S(DTYPE=1:"",1:START_"-"_END_" ")
   47: 	. S START=END+1
   48: 	. Q
   49: 	S INPUTLN=$E(INPUTLN,1,$L(INPUTLN)-1)_";"
   50: 	W INPUTLN,!,"CARDS;"
   51: 	Q
   52: 	;
   53: ORACTL	;
   54: 	N FLD,FLD0,DELIM,NAME,LENGTH,DTYPEFRM,END,START,POS
   55: 	S FLD=0,DELIM=$P(^DIST(.44,DDXPFFNO,0),U,2),START=1,POS=""
   56: 	W "LOAD DATA",!
   57: 	W "INFILE *",!
   58: 	W "APPEND",!
   59: 	W "INTO TABLE "_$TR($P(^DIPT(DDXPXTNO,0),U,1)," ","_"),!
   60: 	W:DELIM]"" "FIELDS TERMINATED BY '"_DELIM_"' OPTIONALLY ENCLOSED BY '""'",!
   61: 	W "("
   62: 	F  S FLD=$O(^DIPT(DDXPXTNO,100,FLD)) Q:FLD<1  W:FLD>1 ",",! S FLD0=^(FLD,0) D
   63: 	. S NAME=$P(FLD0,U,4)_" ",LENGTH=$P(FLD0,U,3)
   64: 	. S DTYPEFRM=$S($P(FLD0,U,2)=1:" DATE 'MON DD,YYYY'",1:"")
   65: 	. I LENGTH>0 D
   66: 	. . S END=START+LENGTH-1
   67: 	. . S POS="POSITION ("_START_":"_END_")"
   68: 	. . S START=END+1
   69: 	. . Q
   70: 	. W NAME_POS_DTYPEFRM
   71: 	W " )",!
   72: 	W "BEGINDATA",!
   73: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>