Return to DDXP32.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DDXP32.m, revision 1.1

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