Return to DDXP3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDXP3.m, revision 1.1.1.1

1.1       snw         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