Return to DITMGM2A.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITMGM2A.m, revision 1.1

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