DDXPLIB ;SFISC/DPC-EXPORT LIBRARY ;1/25/93 13:05
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDXPLIB 2430 printed Dec 13, 2024@02:44:16 Page 2
DDXPLIB ;SFISC/DPC-EXPORT LIBRARY ;1/25/93 13:05
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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
