Return to DITMGM2C.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITMGM2C.m, revision 1.1.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