Return to DDXP3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDXP3.m, revision 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