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

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1DITMGM2A ;SFISC/EDE(OHPRD),TKW-CONTINUATION OF ^DITMGM2 ;4/7/94 08:49
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5FIELD ; PROCESS ONE FIELD IN ONE FILE/SUBFILE
6 S DITMGMPF=^UTILITY("DITMGMRG",$J,DITMGMFL,DITMGMFD)
7 S DITMGMX=$P(^DD(DITMGMFL,DITMGMFD,0),U,4),DITMGMNO=$P(DITMGMX,";",1),DITMGMPC=$P(DITMGMX,";",2),DITMGMDI=$S(DITMGMFD=.01&($P(^(0),U,5,99)["DINUM"):1,1:0)
8 S DITMGMV=$S($P(^DD(DITMGMFL,DITMGMFD,0),U,2)["V":1,1:0)
9 I DITMGMV D
10 . N % S %=$P(^DIC(DITMGMPF,0,"GL"),U,2) I %["""" S %=$$CONVQQ^DILIBF(%)
11 . S DITMGMF=DITMGMF_";"_%,DITMGMT=DITMGMT_";"_% Q
12 S DITMGMXR="",DITMGMX=0 F DITMGML=0:0 S DITMGMX=$O(^DD(DITMGMFL,DITMGMFD,1,DITMGMX)) Q:DITMGMX'=+DITMGMX D Q:DITMGMXR'=""
13 . S DITMGMXR=$P(^(DITMGMX,0),U,2),DITMGMTY=$P(^(0),U,3),DITMGMTZ=$P(^(0),U,1)
14 . I DITMGMTY="",'DITMGMMU Q
15 . I DITMGMTY="",DITMGMMU,DITMGMFL'=DITMGMTZ,'$D(^DD(DITMGMTZ,0,"UP")) Q
16 . S DITMGMXR=""
17 . Q
18 K DA I DITMGMXR="" D NOXREF Q
19 Q:'$D(@(DITMGMG_""""_DITMGMXR_""","""_DITMGMF_""")"))
20 S DITMGMN="" F DITMGML=0:0 S DITMGMN=$O(@(DITMGMG_""""_DITMGMXR_""","""_DITMGMF_""",DITMGMN)")) Q:DITMGMN="" D ENTRY:'DITMGMMU,MULTIPLE:DITMGMMU
21 Q
22 ;
23MULTIPLE ; MULTIPLE WITH XREF TO FILE
24 N DIXR,DICNT,DIDA,DIEND,DITMGZZZ
25 S DITMGZZZ=DITMGMN,(DICNT,DIEND)=+$P(DITMGMGM,"DA(",2),DIDA(DICNT)=DITMGMN
26 S DIXR(DICNT)=DITMGMG_""""_DITMGMXR_""","""_DITMGMF_""","_DITMGMN_","
27 S DICNT=DICNT-1
28M2 I DICNT=DIEND S DITMGMN=DITMGZZZ Q
29 S DIDA(DICNT)=$O(@(DIXR(DICNT+1)_+$G(DIDA(DICNT))_")"))
30 I 'DIDA(DICNT) S DICNT=DICNT+1 G M2
31 I DICNT=0 D G M2
32 . N DA F I=0:1:DIEND S DA(I)=DIDA(I)
33 . S DA=DA(0) K DA(0)
34 . N DIXR,DICNT,DIDA,DIEND D ENTRY
35 . Q
36 S DIXR(DICNT)=DIXR(DICNT+1)_DIDA(DICNT)_","
37 S DICNT=DICNT-1 G M2
38 ;
39NOXREF ; FILES WITH NO REGULAR XREF ON POINTING FIELD
40 I DITMGMDI,'DITMGMMU S DITMGMN=$S($D(@(DITMGMG_DITMGMF_")")):DITMGMF,1:"") D:DITMGMN ENTRY Q ; If DINUM file xref not needed
41 I '$D(@(DITMGMG_"0)")) W:'$D(DITMGM2("NOTALK")) !,"No Data Global: ",DITMGMG Q
42 I '$D(^%ZTSK)!($P(@(DITMGMG_"0)"),U,4)<3001) D SEARCH Q ; If <= 3000 search gbl
43 W:'$D(DITMGM2("NOTALK")) !,"No REGULAR xref on ",DITMGMFL,",",DITMGMFD," Merging entries for this file will",!,"now occur via Taskman in background!"
44 ; SETUP CALL TO TASKMAN
45 K DITMGMZT S:$D(ZTSK) DITMGMZT=ZTSK
46 K ZTSAVE F %="DITMGMG","DITMGMGM","DITMGMNO","DITMGMPC","DITMGMF","DITMGMT","DITMGMFL","DITMGMFD","DITMGMDI","DITMGMXR","DITMGMMU","DITMGMV" S ZTSAVE(%)=""
47 S ZTRTN="ZTM^DITMGM2",ZTDESC="PROCESS POINTER FIELD #"_DITMGMFD_" IN FILE #"_DITMGMFL_" FROM "_DITMGMF_" TO "_DITMGMT
48 S ZTIO="",ZTDTH=DT D ^%ZTLOAD K ZTSK
49 S:$D(DITMGMZT) ZTSK=DITMGMZT
50 K DITMGMZT
51 Q
52 ;
53SEARCH ; $O THRU DATA GBL
54 D SEARCH^DITMGM2B
55 Q
56 ;
57ENTRY ; PROCESS ONE FILE/SUBFILE ENTRY
58 D ENTRY^DITMGM2B
59 Q
60QUOTES ;
61 N %P,%Q S %W1="",%Q="""" F %P=1:1:$L(%W,%Q)-1 S %W1=%W1_$P(%W,%Q,%P)_%Q_%Q
62 S %W1=%W1_$P(%W,%Q,$L(%W,%Q))
63 Q
Note: See TracBrowser for help on using the repository browser.