Return to DITMGM2B.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITMGM2B.m, revision 1.1.1.1

1.1       snw         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