Return to DITMGM2B.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DITMGM2B	;SFISC/EDE(OHPRD),TKW-CONTINUATION OF DITMGM2 ;4/7/94  10:09
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: 	;
    6: SEARCH	; $O THRU DATA GBL
    7: 	Q:'$O(@(DITMGMG_"0)"))
    8: 	W:'$D(DITMGM2("NOTALK")) !,"No REGULAR xref on ",DITMGMFL,",",DITMGMFD,".  ",+$P(^(0),U,4)," entries.  Searching data global."
    9: 	F DITMGMN=0:0 S DITMGMN=$O(@(DITMGMG_DITMGMN_")")) Q:DITMGMN'=+DITMGMN  D
   10: 	. I DITMGMMU D SEARCHM Q
   11: 	. I $D(^(DITMGMN,DITMGMNO)),$P(^(DITMGMNO),U,DITMGMPC)=DITMGMF D ENTRY
   12: 	. Q
   13: 	Q
   14: 	;
   15: SEARCHM	; $O THRU DATA GBL FOR MULTIPLES (TOP)
   16: 	S DITMGMDN=+$P(DITMGMGM,"DA(",2)
   17: 	S DA(DITMGMDN)=DITMGMN,DITMGDA(DITMGMDN)=DITMGMN
   18: 	S DITMGMGG=$P(DITMGMGM,"DA(",1)_"DA("_DITMGMDN_"),"
   19: 	S DITMGMDN=DITMGMDN-1
   20: 	NEW DITMGMN
   21: 	D SEARCHM2
   22: 	K DA,DITMGDA,DITMGMGG
   23: 	Q
   24: 	;
   25: SEARCHM2	; MIDDLE (CALLED RECURSIVELY)
   26: 	I '$F(DITMGMGM,"DA("_DITMGMDN_"),") D SEARCHM3 Q
   27: 	S DITMGMGG=$P(DITMGMGM,",DA("_DITMGMDN_"),",1)_","
   28: 	F DITMGDA(DITMGMDN)=0:0 S DITMGDA(DITMGMDN)=$O(@(DITMGMGG_DITMGDA(DITMGMDN)_")")) Q:DITMGDA(DITMGMDN)'=+DITMGDA(DITMGMDN)  S DA(DITMGMDN)=DITMGDA(DITMGMDN) D SEARCHM4
   29: 	Q
   30: 	;
   31: SEARCHM3	; BOTTOM
   32: 	D SETDA
   33: 	F DITMGMN=0:0 S DITMGMN=$O(@(DITMGMGM_DITMGMN_")")) Q:DITMGMN'=+DITMGMN  I $D(^(DITMGMN,DITMGMNO)),$P(^(DITMGMNO),U,DITMGMPC)=DITMGMF D ENTRY,SETDA
   34: 	Q
   35: 	;
   36: SETDA	; SET DA ARRAY
   37: 	K DA
   38: 	F I=1:1 Q:'$D(DITMGDA(I))  S DA(I)=DITMGDA(I)
   39: 	Q
   40: 	;
   41: SEARCHM4	; RECURSE
   42: 	S DITMGMDN=DITMGMDN-1
   43: 	D SEARCHM2
   44: 	S DITMGMDN=DITMGMDN+1
   45: 	Q
   46: 	;
   47: ENTRY	; PROCESS ONE FILE/SUBFILE ENTRY
   48: 	D ENTRY^DITMGM2C
   49: 	Q
   50: 	;
   51: INIT	;
   52: 	K DITMGMQF
   53: 	K DITMGMRG("ERROR") S DITMGMEC=0
   54: 	S:$D(ZTQUEUED) DITMGM2("NOTALK")=1
   55: 	S:$D(ZTSK) DITMGM2("NOTALK")=1 ; old Kernel
   56: 	I '$D(DITMGMFL) S DITMGMQF=20 Q
   57: 	I 'DITMGMFL S DITMGMQF=20 Q
   58: 	I '$D(^DIC(DITMGMFL,0,"GL")) S DITMGMQF=20 Q
   59: 	S DITMGMFG=^("GL")
   60: 	I '$D(DITMGMF)!('$D(DITMGMT)) S DITMGMQF=21 Q
   61: 	I 'DITMGMF!('DITMGMT)!(DITMGMF=DITMGMT) S DITMGMQF=22 Q
   62: 	I '$D(@(DITMGMFG_DITMGMF_",0)")) S DITMGMQF=23 Q
   63: 	I '$D(@(DITMGMFG_DITMGMT_",0)")) S DITMGMQF=24 Q
   64: 	Q