Return to DDXP3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDXP3	;SFISC/DPC-CREATE EXPORT TEMPLATE ;10/14/94  14:56
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: EN1	;
    5: 	N DDXPNOUT
    6: 	N T,Q S T="~",Q="""" K ^TMP($J,"DIP")
    7: 	N Y,D,DICS D ^DICRW I Y=-1 G QUIT
    8: 	S DDXPFINO=+Y
    9: FLDT	;
   10: 	D FLDTEMP^DDXP33 G:DDXPOUT QUIT
   11: FRMT	;
   12: 	S DIC="^DIST(.44,",DIC(0)="QEAMZ" D ^DIC K DIC
   13: 	G:Y=-1 QUIT
   14: 	S DDXPFMNO=+Y,DDXPFMZO=Y(0)
   15: XPTEMP	;
   16: 	D XPT^DDXP31 G:DDXPOUT QUIT
   17: 	D FLOAD,CAPDT^DDXP32 G:DDXPOUT QUIT
   18: 	I $P(DDXPFMZO,U,6) D LENGTH^DDXP31 G:DDXPOUT QUIT
   19: 	I $P(DDXPFMZO,U,7) D FLDNAME^DDXP31 G:DDXPOUT QUIT
   20: 	I $P(DDXPFMZO,U,11) D DTYPE^DDXP31 G:DDXPOUT QUIT
   21: 	D SETFLD^DDXP32
   22: 	I '$P(DDXPFMZO,U,8) D IOM^DDXP31 G:DDXPOUT QUIT S ^DIPT(DDXPXTNO,"IOM")=$G(DDXPIOM)
   23: 	D SETEMP^DDXP32
   24: SETDELM	;
   25: 	I $TR($P(DDXPFMZO,U,2),"ask","ASK")="ASK" D ASKDELM^DDXP31 G:DDXPOUT QUIT
   26: 	S:'$D(DDXPDELM) DDXPDELM=$P(DDXPFMZO,U,2)
   27: 	I DDXPDELM]"" S DDXPDELM=$$BLDELIM(DDXPDELM)
   28: TPROC	;
   29: 	S DDXPFONO=1,DDXPFOUT="",DDXPXPOS=1
   30: 	F DDXPFLD=1:1:DDXPTOTF D
   31: 	. S (DDXPNPC,DDXPRNPC)=^TMP($J,"TIN",DDXPFLD)
   32: 	. I $P(DDXPFMZO,U,10),'DDXPNOUT(DDXPFLD) D QUOT^DDXP32
   33: 	. I $P(DDXPFMZO,U,6) D FIXLEN
   34: 	. I '$P(DDXPFMZO,U,6),((DDXPFLD'=1)!(DDXPNPC'=DDXPRNPC)) D RUNON
   35: 	. I $P(DDXPFMZO,U,10),'DDXPNOUT(DDXPFLD) D QUOT^DDXP32
   36: 	. I DDXPDELM]"",'DDXPNOUT(DDXPFLD) D DELIM
   37: 	. D FPROC
   38: 	. Q
   39: RECPROC	;
   40: 	I '$P(DDXPFMZO,U,12),DDXPDELM]"" S DDXPFOUT=$P(DDXPFOUT,T,1,($L(DDXPFOUT,T)-2))_T
   41: 	I $TR($P(DDXPFMZO,U,3),"ask","ASK")="ASK" D ASKRDLM^DDXP31 G:DDXPOUT QUIT
   42: 	S:'$D(DDXPRDLM) DDXPRDLM=$P(DDXPFMZO,U,3)
   43: 	I DDXPRDLM]"" S DDXPRDLM=$$BLDELIM(DDXPRDLM) D RECDELIM D FPROC
   44: FINISH	;
   45: 	I DDXPFOUT]"" S ^DIPT(DDXPXTNO,"F",DDXPFONO)=DDXPFOUT
   46: 	S DIE="^DIST(.44,",DA=DDXPFMNO,DR="40///1" D ^DIE
   47: 	S DIE="^DIPT(",DA=DDXPFDTM,DR="110///1" D ^DIE K DIE,DA,DR
   48: 	W !!,?10,"Export Template created.",!
   49: 	I $G(DDXPTMDL) D
   50: 	. S DIK="^DIPT(",DA=DDXPFDTM D ^DIK K DIK,DA
   51: 	. W ?10,"Selected Fields template "_DDXPFDNM_" deleted.",!
   52: 	. Q
   53: 	G DONE
   54: QUIT	;
   55: 	W !!,?10,"Export Template NOT created!!"
   56: 	I $G(DDXPTMDL) W !,?10,"Selected Fields template "_DDXPFDNM_" not deleted."
   57: 	I $D(DDXPXTNO) S DIK="^DIPT(",DA=DDXPXTNO D ^DIK K DIK,DA
   58: DONE	; 
   59: 	K X,Y,DDXPDELM,DDXPDT,DDXPFDTM,DDXPFCAP,DDXPFFNM,DDXPFIN,DDXPFINO,DDXPFLD,DDXPIOM,DDXPFLEN,DDXPFMNO,DDXPFMZO,DDXPFONO,DDXPTLEN,DDXPTMDL
   60: 	K DDXPFDNM,DDXPFOUT,DDXPLNMX,DDXPRNPC,DDXPNPC,DDXPOUT,DDXPTIN,DDXPATH,DDXPTOTF,DDXPXPOS,DDXPXTNM,DDXPXTNO,DDXPRDLM,Q,T,DTOUT,DUOUT,DIRUT
   61: 	K ^TMP($J,"DIP")
   62: 	Q
   63: FLOAD	;
   64: 	S DDXPFLD=0
   65: 	F FIN=0:0 S FIN=$O(^DIPT(DDXPFDTM,"F",FIN)) Q:FIN=""  S DDXPFIN=^(FIN) D
   66: 	. F TCNT=1:1 S DDXPTIN=$P(DDXPFIN,T,TCNT) Q:DDXPTIN=""  D
   67: 	. . S DDXPFLD=DDXPFLD+1
   68: 	. . S ^TMP($J,"TIN",DDXPFLD)=DDXPTIN
   69: 	. . S DDXPNOUT(DDXPFLD)=$$NOUT(DDXPTIN)
   70: 	. . Q
   71: 	. Q
   72: 	S DDXPTOTF=DDXPFLD
   73: 	K FIN,TCNT Q
   74: FIXLEN	;
   75: 	S DDXPLNMX=$S(+$P(DDXPFMZO,U,8):$P(DDXPFMZO,U,8),$G(DDXPIOM):DDXPIOM,1:80)
   76: 	I DDXPXPOS+DDXPFLEN(DDXPFLD)>(DDXPLNMX+1) S DDXPXPOS=1
   77: 	S DDXPNPC=DDXPNPC_";L"_DDXPFLEN(DDXPFLD)_";C"_DDXPXPOS
   78: 	S DDXPXPOS=DDXPXPOS+DDXPFLEN(DDXPFLD)
   79: 	Q
   80: RUNON	;
   81: 	S DDXPNPC=DDXPNPC_";X"
   82: 	Q
   83: DELIM	;
   84: 	S DDXPNPC=DDXPNPC_T_"W $C("_DDXPDELM_")"
   85: 	I '$P(DDXPFMZO,U,6) D RUNON
   86: 	Q
   87: RECDELIM	;
   88: 	S DDXPNPC="W $C("_DDXPRDLM_")"
   89: 	I '$P(DDXPFMZO,U,6) D RUNON
   90: 	Q
   91: BLDELIM(%)	;
   92: 	N CHAR,DELM
   93: 	I +% S DELM=% G BLDOUT
   94: 	S DELM=$A(%)
   95: 	F CHAR=2:1 Q:$E(%,CHAR)=""  S DELM=DELM_","_$A($E(%,CHAR))
   96: BLDOUT	Q DELM
   97: FPROC	;
   98: 	I $L(DDXPFOUT)+$L(DDXPNPC)<220 S DDXPFOUT=DDXPFOUT_DDXPNPC_T Q
   99: 	S ^DIPT(DDXPXTNO,"F",DDXPFONO)=DDXPFOUT
  100: 	S DDXPFOUT=DDXPNPC_T,DDXPFONO=DDXPFONO+1
  101: 	Q
  102: 	;
  103: NOUT(DDXPTIN)	;
  104: 	I DDXPTIN["SETDATA"!(DDXPTIN["SETPARAM") Q 1
  105: 	Q 0