Return to DITMGM2A.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DITMGM2A	;SFISC/EDE(OHPRD),TKW-CONTINUATION OF ^DITMGM2 ;4/7/94  08:49
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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