Return to DITMGMRG.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITMGMRG.m, revision 1.1

1.1     ! snw         1: DITMGMRG       ;SFISC/EDE(OHPRD)-RELINK/MERGE TWO ENTRIES BELOW POINTED TO FILE ;2/24/94  16:10
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5:        ; Merge two entries below pointed to file.  See ^DITMDOC.
        !             6:        ;
        !             7: START  ;
        !             8:        D ^DITMGM1
        !             9:        I 'DITMGMRG("GO") D EOJ K DITMGMRG Q
        !            10:        D EN
        !            11:        K DITMGMRG
        !            12:        Q
        !            13:        ;
        !            14: EN     ; EXTERNAL ENTRY POINT
        !            15:        D INIT^DITMGMRI
        !            16:        Q:$D(DITMGMQF)
        !            17:        D STACK
        !            18:        S:$D(DITMGMRG("NOTALK")) DITMGM2("NOTALK")=1
        !            19:        D ^DITMGM2 K DITMGM2("NOTALK")
        !            20:        K ^UTILITY("DITMGMRG",$J)
        !            21:        W:'$D(DITMGMRG("NOTALK")) !!,"Merge complete",!!
        !            22:        D EOJ
        !            23:        Q
        !            24:        ;
        !            25: STACK  ;STACK ALL FILES POINTING TO POINTED TO FILE AND IF .01 FIELD
        !            26:        ;POINTING AND DINUM, FILES POINTING TO POINTING FILE, AND SO ON.
        !            27:        ;
        !            28:        W:'$D(DITMGMRG("NOTALK")) !!,"Gathering files and checking 'PT' nodes"
        !            29:        NEW DITMGFLE,DITMGPFL,DITMGPFD,DITMSKP
        !            30:        K ^UTILITY("DITMGMRG",$J)
        !            31:        S DITMGFLE=DITMGMRG("FILE")
        !            32:        D FILES
        !            33:        Q
        !            34:        ;
        !            35: FILES  ; CALLED RECURSIVELY
        !            36:        D PTCHK
        !            37:        F DITMGPFL=0:0 S DITMGPFL=$O(^DD(DITMGFLE,0,"PT",DITMGPFL)) Q:DITMGPFL'=+DITMGPFL  D  I 'DITMSKP D FIELDS
        !            38:        . S DITMSKP=0
        !            39:        . I $D(DITMGMRG("EXCLUDE",DITMGPFL)) S DITMSKP=1 Q
        !            40:        . ;I DITMGFLE=DITMGPFL S DITMSKP=1 Q
        !            41:        . Q:'$D(DITMGMRG("PACKAGE"))
        !            42:        . I DITMGMRG("PACKAGE") S:'$D(DITMGMRG("PACKAGE",DITMGPFL)) DITMSKP=1 Q
        !            43:        . Q
        !            44:        Q
        !            45:        ;
        !            46: FIELDS ;
        !            47:        ;W:'$D(DITMGMRG("NOTALK")) "f"
        !            48:        F DITMGPFD=0:0 S DITMGPFD=$O(^DD(DITMGFLE,0,"PT",DITMGPFL,DITMGPFD)) Q:DITMGPFD'=+DITMGPFD  D
        !            49:        . S ^UTILITY("DITMGMRG",$J,DITMGPFL,DITMGPFD)=DITMGFLE
        !            50:        . ;W:'$D(DITMGMRG("NOTALK")) $S($D(^DD(DITMGPFL,0,"UP")):"s",1:".")
        !            51:        . I DITMGPFD=.01,'$D(^DD(DITMGPFL,0,"UP")),$P(^DD(DITMGPFL,.01,0),U,5,99)["DINUM" D RECURSE
        !            52:        Q
        !            53:        ;
        !            54: RECURSE        ;
        !            55:        ;W:'$D(DITMGMRG("NOTALK")) "d"
        !            56:        NEW DITMGFLE
        !            57:        S DITMGFLE=DITMGPFL
        !            58:        NEW DITMGPFL,DITMGPFD
        !            59:        D FILES
        !            60:        Q
        !            61:        ;
        !            62: PTCHK  ; MAKE SURE "PT" CORRECT
        !            63:        I '$D(DITMGMRG("NOTALK")) ;W $S(DITMGMRG("FILE")=DITMGFLE:"",1:"[")
        !            64:        E  S DITMU4("NOTALK")=1
        !            65:        S DITMU4FI=DITMGFLE
        !            66:        F DITMU4PF=0:0 S DITMU4PF=$O(^DD(DITMU4FI,0,"PT",DITMU4PF)) Q:DITMU4PF=""  F DITMU4PD=0:0 S DITMU4PD=$O(^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)) Q:DITMU4PD=""  D CHKIT^DITMU4
        !            67:        K DITMU4FI,DITMU4L,DITMU4PF,DITMU4PD,DITMU4X,DITMU4("NOTALK")
        !            68:        ;I DITMGMRG("FILE")'=DITMGFLE,'$D(DITMGMRG("NOTALK")) W "]"
        !            69:        Q
        !            70:        ;
        !            71: EOJ    ;
        !            72:        K X,Y
        !            73:        K %,DIPGM
        !            74:        I $D(DITMGMQF) S DITMGMRG("QFLG")=DITMGMQF
        !            75:        K DITMGMF,DITMGMFG,DITMGMFL,DITMGMQF,DITMGMT
        !            76:        K AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
        !            77:        I $D(ZTQUEUED) S ZTREQ="@" Q
        !            78:        I $D(ZTSK) K ^%ZTSK(ZTSK),ZTSK Q  ; old Kernel
        !            79:        I '$D(DITMGMRG("NOTALK")),$D(DITMGMRG("ERROR")) D EOJ2 K DITMGMRG("ERROR")
        !            80:        Q
        !            81:        ;
        !            82: EOJ2   ; List errors
        !            83:        W !!,"The following errors occurred during the merge: ",!
        !            84:        F %=0:0 S %=$O(DITMGMRG("ERROR",%)) Q:%'=+%  W !,DITMGMRG("ERROR",%)
        !            85:        W !
        !            86:        K %
        !            87:        Q