Return to DDXP32.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDXP32	;SFISC/DPC-CREATE EXPORT TEMPLATE (CONT) ;10/14/94  14:57
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: CAPDT	;
    5: 	K DDXPFCAP,DDXPDT,DDXPATH N FCAP,NUMPC,C S C=","
    6: 	F DDXPCNDX=1:1:DDXPTOTF D
    7: 	. I DDXPNOUT(DDXPCNDX) Q
    8: 	. S DDXPX=^TMP($J,"TIN",DDXPCNDX),DDXPTGFL=DDXPFINO,NUMPC=0 K FCAP
    9: 	. D FLDFIND
   10: 	. S DDXPFCAP(DDXPCNDX)=FCAP(NUMPC)
   11: 	. F NUMPC=NUMPC-1:-1 Q:'$D(FCAP(NUMPC))  D
   12: 	. . S DDXPFCAP(DDXPCNDX)=DDXPFCAP(DDXPCNDX)_" in "_FCAP(NUMPC)_" subfile"
   13: 	. . Q
   14: 	. K FCAP,NUMPC
   15: 	. Q
   16: 	I $D(DDXPATH) D MULTVER
   17: 	K DDXPX,DDXPCNDX,DDXPTGFL,DDXPDD0 Q
   18: FLDFIND	;
   19: 	S NUMPC=NUMPC+1
   20: 	I DDXPX=0 D  Q
   21: 	. S FCAP(NUMPC)="NUMBER",DDXPDT(DDXPCNDX)=4
   22: 	. Q
   23: 	I +DDXPX D
   24: 	. S DDXPDD0="^DD("_DDXPTGFL_","_+DDXPX_",0)"
   25: 	. Q
   26: 	I DDXPX=+DDXPX D  Q
   27: 	. S FCAP(NUMPC)=$P(@DDXPDD0,U,1)
   28: 	. S %=$P(@DDXPDD0,U,2),DDXPDT(DDXPCNDX)=$S(%["D":1,%["N":2,1:4) K %
   29: 	. Q
   30: 	I '+DDXPX D  Q
   31: 	. S DDXPDT(DDXPCNDX)=4
   32: 	. I $E(DDXPX)=Q S FCAP(NUMPC)=DDXPX Q
   33: 	. S %=$P(DDXPX,";Z;",2),%=$P(%,Q,2,99),%=$P(%,";",1),FCAP(NUMPC)=$E(%,1,($L(%)-1)) K %
   34: 	. Q
   35: MULT	;
   36: 	S FCAP(NUMPC)=$P(@DDXPDD0,U,1)
   37: 	S DDXPTGFL=+$P(@DDXPDD0,U,2)
   38: 	I NUMPC=1 D
   39: 	. N %,I,DONE S %=$P(DDXPX,C,1,$L(DDXPX,C)-1),DONE=0
   40: 	. F I=2:1:$L(DDXPX,C) Q:DONE  D
   41: 	. . Q:+$P(%,C,I)
   42: 	. . S %=$P(%,C,1,I-1),DONE=1
   43: 	. . Q
   44: 	. S DDXPATH(DDXPCNDX)=%
   45: 	. Q
   46: 	S DDXPX=$P(DDXPX,C,2,99)
   47: 	G FLDFIND
   48: SETFLD	;
   49: 	S %L=$S($D(DDXPFLEN):";2///^S X=DDXPFLEN(DDXPFLD)",1:"")
   50: 	S %F=$S($D(DDXPFFNM):";3///^S X=DDXPFFNM(DDXPFLD)",1:"")
   51: 	S (DIC,DIE)="^DIPT("_DDXPXTNO_",100,",DA(1)=DDXPXTNO,DIC("P")=$P(^DD(.4,100,0),U,2),DIC(0)="L" K DO
   52: 	F DDXPFLD=1:1:DDXPTOTF D
   53: 	. I DDXPNOUT(DDXPFLD) Q
   54: 	. S (DINUM,X)=DDXPFLD K DD D FILE^DICN
   55: 	. S DA=DDXPFLD,DR="1////^S X=DDXPDT(DDXPFLD)"_%L_%F D ^DIE
   56: 	. Q
   57: 	K DIE,DIC,X,Y,DA,DR,%L,%F
   58: 	Q
   59: SETEMP	;
   60: 	S DR="2///NOW;3///"_DUZ(0)_";4///"_DDXPFINO_";5///"_DUZ_";6///"_DUZ(0)_";8///3;105////"_DDXPFMNO S:$G(DDXPATH) DR=DR_";115///"_DDXPATH
   61: 	S DA=DDXPXTNO,DIE="^DIPT(" D ^DIE K DIE,DA,DR
   62: 	S %X="^DIPT("_DDXPFDTM_",""DXS"",",%Y="^DIPT("_DDXPXTNO_",""DXS""," D %XY^%RCR K %X,%Y
   63: 	S ^DIPT(DDXPXTNO,"SUB")=1
   64: 	S ^DIPT(DDXPXTNO,"H")="@@"
   65: 	Q
   66: MULTVER	;
   67: 	N I,MP,LP,MPC,LPC,NOMATCH S LP="",NOMATCH=0
   68: 	F I=1:1:DDXPTOTF D  Q:NOMATCH
   69: 	. S MP=$G(DDXPATH(I)) Q:'MP
   70: 	. I LP=MP Q
   71: 	. I 'LP S LP=MP Q
   72: 	. S LPC=$L(LP,C),MPC=$L(MP,C)
   73: 	. I LPC=MPC S NOMATCH=1 Q
   74: 	. I LPC>MPC D  Q
   75: 	. . I MP=$P(LP,C,1,MPC) Q
   76: 	. . S NOMATCH=1
   77: 	. . Q
   78: 	. I LP=$P(MP,C,1,LPC) S LP=MP Q
   79: 	. S NOMATCH=1
   80: 	. Q
   81: 	I 'NOMATCH S DDXPATH=LP Q
   82: 	W !!,$C(7),"The "_DDXPFDNM_" template has fields in more than one multiple path."
   83: 	W !,"Therefore, export of the data will not succeed."
   84: 	W !,"Refer to the VA FileMan User Manual for more details.",!
   85: 	S DDXPOUT=1
   86: 	Q
   87: QUOT	;
   88: 	N QPC,Q1ST
   89: 	I DDXPDT(DDXPFLD)=2 Q
   90: 	S Q1ST=$S(DDXPNPC=DDXPRNPC:1,1:0)
   91: 	S QPC="W $C(34)"_$S(Q1ST&(DDXPFLD=1):"",1:";X")
   92: 	I Q1ST S DDXPNPC=QPC_T_DDXPNPC
   93: 	E  S DDXPNPC=DDXPNPC_T_QPC
   94: 	Q