Return to DDXP32.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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