Return to DITMGM2C.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITMGM2C.m, revision 1.1

1.1     ! snw         1: DITMGM2C       ;SFISC/EDE(OHPRD)TKW-CONTINUATION OF DITMGM2 ;5/11/94  15:16
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: ENTRY  ; PROCESS ONE FILE/SUBFILE ENTRY
        !             6:        ;
        !             7:        W:'$D(DITMGM2("NOTALK")) "."
        !             8:        I DITMGMDI D DINUM Q  ; merge dinum entries
        !             9:        ;
        !            10:        ; ----- Transform DITMGMT
        !            11:        S DITMGM("DITMGMT")=DITMGMT
        !            12:        I 'DITMGMV S DITMGMT=$S(DITMGMFD=.01:"`",1:"/")_DITMGMT I 1
        !            13:        E  S X=$P(DITMGMT,";",2),DITMGMT=$P(DITMGMT,";",1),X=+$P(@("^"_X_"0)"),U,2) D  Q:X=""  S DITMGMT=X_".`"_DITMGMT
        !            14:        . S X=$O(^DD(DITMGMFL,DITMGMFD,"V","B",X,0))
        !            15:        . Q:X=""
        !            16:        . S X=$P(^DD(DITMGMFL,DITMGMFD,"V",X,0),U,4)
        !            17:        . Q
        !            18:        ; -----
        !            19:        ;
        !            20:        I DITMGMMU D ENTRYM I 1
        !            21:        E  D ENTRYS
        !            22:        S DITMGMT=DITMGM("DITMGMT") K DITMGM("DITMGMT")
        !            23:        Q
        !            24:        ;
        !            25: ENTRYS ;
        !            26:        ;
        !            27:        S DITC="",DA=DITMGMN,D0=DA,DIE=DITMGMG,DR=DITMGMFD_"///"_DITMGMT
        !            28:        D ^DIE K DA,DIE,DITC,DR,D0
        !            29:        I $D(Y) S DITMGMEC=DITMGMEC+1,DITMGMRG("ERROR",DITMGMEC)="DIE"_U_DITMGMFL_U_DITMGMFD_U_DITMGMN_U_DITMGMF_U_DITMGMT
        !            30:        Q
        !            31:        ;
        !            32: ENTRYM ; PROCESS ONE SUBFILE ENTRY
        !            33:        S DITC="",DIE=DITMGMGM,DA=DITMGMN,DR=DITMGMFD_"///"_DITMGMT
        !            34:        D ^DITMU1 ; Set D0, D1, etc.
        !            35:        D ^DIE K DA,DIE,DITC,DR
        !            36:        D KILL^DITMU1 ; Kill D0, D1, etc.
        !            37:        I $D(Y) S DITMGMEC=DITMGMEC+1,DITMGMRG("ERROR",DITMGMEC)="DIE"_U_DITMGMFL_U_DITMGMFD_U_DITMGMN_U_DITMGMF_U_DITMGMT
        !            38:        Q
        !            39:        ;
        !            40: DINUM  ; DINUM FILE
        !            41:        ; Move the 'from' entry to it's new IEN location.  Do a merge
        !            42:        ; if there is already a record at that location.
        !            43:        ;
        !            44:        N DIDA,DIK,DITMFROM S DITMFROM=$S(DITMGMMU:DITMGMGM,1:DITMGMG)
        !            45:        S $P(@(DITMFROM_DITMGMF_",0)"),U)=DITMGMT
        !            46:        I '$D(@(DITMFROM_DITMGMT_",0)")) D
        !            47:        . S @(DITMFROM_DITMGMT_",0)")=DITMGMT
        !            48:        . S $P(@(DITMFROM_"0)"),U,3,4)=DITMGMT_"^"_($P(@(DITMFROM_"0)"),U,4)+1)
        !            49:        . Q
        !            50:        S DIDA=$S('DITMGMMU:",",1:$$IEN^DIEFU(.DA)),DIDA("F")=DITMGMF_DIDA,DIDA("T")=DITMGMT_DIDA
        !            51:        D TRNMRG^DIT("M",DITMGMFL,"",DIDA("F"),DIDA("T"))
        !            52:        S $P(@(DITMFROM_DITMGMF_",0)"),U)=DITMGMF
        !            53:        D
        !            54:        . N DA D DA^DIEFU(DIDA("T"),.DA) Q:$D(DIERR) 
        !            55:        . K DIK S DIK=$$ROOT^DIQGU(DITMGMFL,DIDA("T")) Q:$D(DIERR)
        !            56:        . N DIDA D IXALL^DIK Q
        !            57:        D
        !            58:        . N DA D DA^DIEFU(DIDA("F"),.DA) Q:$D(DIERR)
        !            59:        . K DIK S DIK=$$ROOT^DIQGU(DITMGMFL,DIDA("F")) Q:$D(DIERR)
        !            60:        . N DIDA D ^DIK Q
        !            61:        Q