source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDXP32.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1DDXP32 ;SFISC/DPC-CREATE EXPORT TEMPLATE (CONT) ;12:44 PM 7 Jun 1999
2 ;;22.0;VA FileMan;**9**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4CAPDT ;
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
18FLDFIND ;
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
35MULT ;
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
48SETFLD ;
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
59SETEMP ;
60 S DR="2///NOW;4///"_DDXPFINO_";5///"_DUZ_";8///3;105////"_DDXPFMNO S:$G(DDXPATH) DR=DR_";115///"_DDXPATH
61 S DA=DDXPXTNO,DIE="^DIPT(" D ^DIE K DIE,DA,DR
62 ; Hard Set ReadAccess and WriteAccess
63 I $D(^DIPT(DDXPXTNO,0))#2,$D(DUZ(0))#2 D
64 . S $P(^DIPT(DDXPXTNO,0),U,3)=DUZ(0) ; Read Access
65 . S $P(^DIPT(DDXPXTNO,0),U,6)=DUZ(0) ; Write Access
66 S %X="^DIPT("_DDXPFDTM_",""DXS"",",%Y="^DIPT("_DDXPXTNO_",""DXS""," D %XY^%RCR K %X,%Y
67 S ^DIPT(DDXPXTNO,"SUB")=1
68 S ^DIPT(DDXPXTNO,"H")="@@"
69 Q
70MULTVER ;
71 N I,MP,LP,MPC,LPC,NOMATCH S LP="",NOMATCH=0
72 F I=1:1:DDXPTOTF D Q:NOMATCH
73 . S MP=$G(DDXPATH(I)) Q:'MP
74 . I LP=MP Q
75 . I 'LP S LP=MP Q
76 . S LPC=$L(LP,C),MPC=$L(MP,C)
77 . I LPC=MPC S NOMATCH=1 Q
78 . I LPC>MPC D Q
79 . . I MP=$P(LP,C,1,MPC) Q
80 . . S NOMATCH=1
81 . . Q
82 . I LP=$P(MP,C,1,LPC) S LP=MP Q
83 . S NOMATCH=1
84 . Q
85 I 'NOMATCH S DDXPATH=LP Q
86 W !!,$C(7),"The "_DDXPFDNM_" template has fields in more than one multiple path."
87 W !,"Therefore, export of the data will not succeed."
88 W !,"Refer to the VA FileMan User Manual for more details.",!
89 S DDXPOUT=1
90 Q
91QUOT ;
92 N QPC,Q1ST
93 I DDXPDT(DDXPFLD)=2 Q
94 S Q1ST=$S(DDXPNPC=DDXPRNPC:1,1:0)
95 S QPC="W $C(34)"_$S(Q1ST&(DDXPFLD=1):"",1:";X")
96 I Q1ST S DDXPNPC=QPC_T_DDXPNPC
97 E S DDXPNPC=DDXPNPC_T_QPC
98 Q
Note: See TracBrowser for help on using the repository browser.