| 1 | DITMGM2A ;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 | ;
|
|---|
| 5 | FIELD ; 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 | ;
|
|---|
| 23 | MULTIPLE ; 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
|
|---|
| 28 | M2 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 | ;
|
|---|
| 39 | NOXREF ; 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 | ;
|
|---|
| 53 | SEARCH ; $O THRU DATA GBL
|
|---|
| 54 | D SEARCH^DITMGM2B
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ENTRY ; PROCESS ONE FILE/SUBFILE ENTRY
|
|---|
| 58 | D ENTRY^DITMGM2B
|
|---|
| 59 | Q
|
|---|
| 60 | QUOTES ;
|
|---|
| 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
|
|---|
