Routine: DITMGM2B

DITMGM2B ;SFISC/EDE(OHPRD),TKW-CONTINUATION OF DITMGM2 ;4/7/94  10:09

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

SEARCH ; $O THRU DATA GBL

 Q:'$O(@(DITMGMG_"0)"))

 W:'$D(DITMGM2("NOTALK")) !,"No REGULAR xref on ",DITMGMFL,",",DITMGMFD,".  ",+$P(^(0),U,4)," entries.  Searching data global."

 F DITMGMN=0:0 S DITMGMN=$O(@(DITMGMG_DITMGMN_")")) Q:DITMGMN'=+DITMGMN  D

 . I DITMGMMU D SEARCHM Q

 . I $D(^(DITMGMN,DITMGMNO)),$P(^(DITMGMNO),U,DITMGMPC)=DITMGMF D ENTRY

. Q

SEARCHM ; $O THRU DATA GBL FOR MULTIPLES (TOP)

 S DITMGMDN=+$P(DITMGMGM,"DA(",2)

 S DA(DITMGMDN)=DITMGMN,DITMGDA(DITMGMDN)=DITMGMN

 S DITMGMGG=$P(DITMGMGM,"DA(",1)_"DA("_DITMGMDN_"),"

 S DITMGMDN=DITMGMDN-1

 NEW DITMGMN

 D SEARCHM2

 K DA,DITMGDA,DITMGMGG

SEARCHM2 ; MIDDLE (CALLED RECURSIVELY)

 I '$F(DITMGMGM,"DA("_DITMGMDN_"),") D SEARCHM3 Q

 S DITMGMGG=$P(DITMGMGM,",DA("_DITMGMDN_"),",1)_","

 F DITMGDA(DITMGMDN)=0:0 S DITMGDA(DITMGMDN)=$O(@(DITMGMGG_DITMGDA(DITMGMDN)_")")) Q:DITMGDA(DITMGMDN)'=+DITMGDA(DITMGMDN)  S DA(DITMGMDN)=DITMGDA(DITMGMDN) D SEARCHM4

SEARCHM3 ; BOTTOM

 D SETDA

 F DITMGMN=0:0 S DITMGMN=$O(@(DITMGMGM_DITMGMN_")")) Q:DITMGMN'=+DITMGMN  I $D(^(DITMGMN,DITMGMNO)),$P(^(DITMGMNO),U,DITMGMPC)=DITMGMF D ENTRY,SETDA

SETDA ; SET DA ARRAY

 K DA

 F I=1:1 Q:'$D(DITMGDA(I))  S DA(I)=DITMGDA(I)

SEARCHM4 ; RECURSE

 S DITMGMDN=DITMGMDN-1

 D SEARCHM2

 S DITMGMDN=DITMGMDN+1

ENTRY ; PROCESS ONE FILE/SUBFILE ENTRY

 D ENTRY^DITMGM2C

INIT ;

 K DITMGMQF

 K DITMGMRG("ERROR") S DITMGMEC=0

 S:$D(ZTQUEUED) DITMGM2("NOTALK")=1

 S:$D(ZTSK) DITMGM2("NOTALK")=1 ; old Kernel

 I '$D(DITMGMFL) S DITMGMQF=20 Q

 I 'DITMGMFL S DITMGMQF=20 Q

 I '$D(^DIC(DITMGMFL,0,"GL")) S DITMGMQF=20 Q

 S DITMGMFG=^("GL")

 I '$D(DITMGMF)!('$D(DITMGMT)) S DITMGMQF=21 Q

 I 'DITMGMF!('DITMGMT)!(DITMGMF=DITMGMT) S DITMGMQF=22 Q

 I '$D(@(DITMGMFG_DITMGMF_",0)")) S DITMGMQF=23 Q

 I '$D(@(DITMGMFG_DITMGMT_",0)")) S DITMGMQF=24 Q

DITMGM2B  ;SFISC/EDE(OHPRD),TKW-CONTINUATION OF DITMGM2 ;4/7/94  10:09

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;

SEARCH    ; $O THRU DATA GBL

 +1        IF '$ORDER(@(DITMGMG_"0)"))

               QUIT

 +2        IF '$DATA(DITMGM2("NOTALK"))

               WRITE !,"No REGULAR xref on ",DITMGMFL,",",DITMGMFD,".  ",+$PIECE(^(0),U,4)," entries.  Searching data global."

 +3        FOR DITMGMN=0:0

               SET DITMGMN=$ORDER(@(DITMGMG_DITMGMN_")"))

               IF DITMGMN'=+DITMGMN

                   QUIT

               Begin DoDot:1

 +4                IF DITMGMMU

                       DO SEARCHM

                       QUIT

 +5                IF $DATA(^(DITMGMN,DITMGMNO))

                       IF $PIECE(^(DITMGMNO),U,DITMGMPC)=DITMGMF

                           DO ENTRY

 +6                QUIT

               End DoDot:1

 +7        QUIT

 +8       ;

SEARCHM   ; $O THRU DATA GBL FOR MULTIPLES (TOP)

 +1        SET DITMGMDN=+$PIECE(DITMGMGM,"DA(",2)

 +2        SET DA(DITMGMDN)=DITMGMN

           SET DITMGDA(DITMGMDN)=DITMGMN

 +3        SET DITMGMGG=$PIECE(DITMGMGM,"DA(",1)_"DA("_DITMGMDN_"),"

 +4        SET DITMGMDN=DITMGMDN-1

 +5        NEW DITMGMN

 +6        DO SEARCHM2

 +7        KILL DA,DITMGDA,DITMGMGG

 +8        QUIT

 +9       ;

SEARCHM2  ; MIDDLE (CALLED RECURSIVELY)

 +1        IF '$FIND(DITMGMGM,"DA("_DITMGMDN_"),")

               DO SEARCHM3

               QUIT

 +2        SET DITMGMGG=$PIECE(DITMGMGM,",DA("_DITMGMDN_"),",1)_","

 +3        FOR DITMGDA(DITMGMDN)=0:0

               SET DITMGDA(DITMGMDN)=$ORDER(@(DITMGMGG_DITMGDA(DITMGMDN)_")"))

               IF DITMGDA(DITMGMDN)'=+DITMGDA(DITMGMDN)

                   QUIT

               SET DA(DITMGMDN)=DITMGDA(DITMGMDN)

               DO SEARCHM4

 +4        QUIT

 +5       ;

SEARCHM3  ; BOTTOM

 +1        DO SETDA

 +2        FOR DITMGMN=0:0

               SET DITMGMN=$ORDER(@(DITMGMGM_DITMGMN_")"))

               IF DITMGMN'=+DITMGMN

                   QUIT

               IF $DATA(^(DITMGMN,DITMGMNO))

                   IF $PIECE(^(DITMGMNO),U,DITMGMPC)=DITMGMF

                       DO ENTRY

                       DO SETDA

 +3        QUIT

 +4       ;

SETDA     ; SET DA ARRAY

 +1        KILL DA

 +2        FOR I=1:1

               IF '$DATA(DITMGDA(I))

                   QUIT

               SET DA(I)=DITMGDA(I)

 +3        QUIT

 +4       ;

SEARCHM4  ; RECURSE

 +1        SET DITMGMDN=DITMGMDN-1

 +2        DO SEARCHM2

 +3        SET DITMGMDN=DITMGMDN+1

 +4        QUIT

 +5       ;

ENTRY     ; PROCESS ONE FILE/SUBFILE ENTRY

 +1        DO ENTRY^DITMGM2C

 +2        QUIT

 +3       ;

INIT      ;

 +1        KILL DITMGMQF

 +2        KILL DITMGMRG("ERROR")

           SET DITMGMEC=0

 +3        IF $DATA(ZTQUEUED)

               SET DITMGM2("NOTALK")=1

 +4       ; old Kernel

           IF $DATA(ZTSK)

               SET DITMGM2("NOTALK")=1

 +5        IF '$DATA(DITMGMFL)

               SET DITMGMQF=20

               QUIT

 +6        IF 'DITMGMFL

               SET DITMGMQF=20

               QUIT

 +7        IF '$DATA(^DIC(DITMGMFL,0,"GL"))

               SET DITMGMQF=20

               QUIT

 +8        SET DITMGMFG=^("GL")

 +9        IF '$DATA(DITMGMF)!('$DATA(DITMGMT))

               SET DITMGMQF=21

               QUIT

 +10       IF 'DITMGMF!('DITMGMT)!(DITMGMF=DITMGMT)

               SET DITMGMQF=22

               QUIT

 +11       IF '$DATA(@(DITMGMFG_DITMGMF_",0)"))

               SET DITMGMQF=23

               QUIT

 +12       IF '$DATA(@(DITMGMFG_DITMGMT_",0)"))

               SET DITMGMQF=24

               QUIT

 +13       QUIT

DITMGM2B.m