Return to DITMGMRG.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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