Return to DIFROMS5.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DIFROMS5.m, revision 1.1

1.1     ! snw         1: DIFROMS5       ;SCISC/DCL-DIFROM SERVER PROCESS TEMPLATES OUT;08:07 AM  1 Dec 1994;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        Q
        !             5:        ;
        !             6: EDEOUT ;EXTENDED DATABASE ELEMENTS OUT
        !             7:        N DIFRDSV,DIFRF,DIFRGBL,DIFRSEC,DIFRTRT
        !             8:        I $G(DIFRIEN)>0 G EDE
        !             9:        N DIFRIENX,DIFRIENZ
        !            10:        S DIFRIENX=$O(@DIFRLST@(0)),DIFRIENZ=$D(@DIFRLST@(DIFRIENX,0))#2,DIFRIENX=0
        !            11:        F  S DIFRIENX=$O(@DIFRLST@(DIFRIENX)) Q:DIFRIENX'>0  D
        !            12:        .I DIFRIENZ S DIFRIEN=+@DIFRLST@(DIFRIENX,0) S:DIFRIEN'>0 DIFRIEN=DIFRIENX D EDE Q
        !            13:        .S DIFRIEN=+@DIFRLST@(DIFRIENX) S:DIFRIEN'>0 DIFRIEN=DIFRIENX D EDE Q
        !            14:        Q
        !            15: EDE    ;
        !            16:        ;  DIFRTRT=FULL ROOT IN DIST ARRAY
        !            17:        ;  DIFRDSV=0TH NODE OF TEMPLATE
        !            18:        ;         :.401, .4, .402
        !            19:        ;         :TEMPL NAME^DATE CREATED^READ^FILENR^DUZ^WRITE^DATE LAST USED
        !            20:        ;         :.403
        !            21:        ;         :FORM NAME^READ^WRITE^DUZ^DATE CREATED^DATA LAST USED^^FILE^
        !            22:        ;         :.84
        !            23:        ;         :DIALOG NUMBER^TYPE^INTERNAL PARM^PACKAGE FILE (pointer)
        !            24:        ;  DIFRSEC=FILE SECURITY 1=EXPORT SECURITY,0=NO FILE SECURITY
        !            25:        ;  DIFRIEN=TEMPLATE'S INTERNAL ENTRY NUMBER
        !            26:        ;         :.5 (FUNCTIONS)
        !            27:        S DIFRTRT=$NA(@DIFRTA@(DIFRFILE,DIFRIEN))
        !            28:        S DIFRGBL=$$ROOT^DILFD(DIFRFILE,"",1)
        !            29:        ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        !            30:        ;
        !            31:        ; For stand alone FileMan only - KIDS will do the Merge
        !            32:        ; v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v
        !            33:        ;
        !            34:        I $G(DIFRSTNA) S DIFRGBL=$$ROOT^DILFD(DIFRFILE,"",1) M @DIFRTRT=@DIFRGBL@(DIFRIEN)
        !            35:        ;
        !            36:        ; ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
        !            37:        ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        !            38:        I DIFRFILE=.5 Q  ;no processing necessary
        !            39:        S DIFRDSV=$G(@DIFRTRT@(0)),DIFRF=$P(DIFRDSV,U,$S(DIFRFILE=.403:8,1:4))
        !            40:        I DIFRDSV="" D  Q
        !            41:        .N DIFRERR S DIFRERR(1)=DIFRFNAM,DIFRERR(2)=DIFRIEN
        !            42:        .D BLD^DIALOG(9516,.DIFRERR)
        !            43:        .Q
        !            44:        I DIFRFILE=.84 G DIALOG
        !            45:        S DIFRSEC=$TR($P($G(@DIFRFIA@(DIFRF,0,1)),U,2),"y","Y")="Y"
        !            46:        I DIFRFILE=.403 G T403
        !            47:        Q:'$D(@DIFRTRT@(0))  K ^("RD"),^("AB") K:DIFRFILE=.401 ^(1)
        !            48:        S $P(@DIFRTRT@(0),U,5)="" S:'DIFRSEC ^(0)=$P(DIFRDSV,U,1,2)_U_U_DIFRF_U_U_U_U_$P(DIFRDSV,U,8)
        !            49:        Q
        !            50:        ;
        !            51: T403   ;PROCESS FORMS AND EACH BLOCK IT CONTAINES
        !            52:        S $P(DIFRDSV,U,4)="",$P(DIFRDSV,U,6)="" S:'DIFRSEC $P(DIFRDSV,U,2,3)=U
        !            53:        S @DIFRTRT@(0)=DIFRDSV
        !            54:        D T404
        !            55:        K @DIFRTRT@("AZ"),@DIFRTRT@(40,"B"),^("C")
        !            56:        N X
        !            57:        S X=0
        !            58:        F  S X=$O(@DIFRTRT@(40,X)) Q:X'>0  K @DIFRTRT@(40,X,40,"AC"),^("B")
        !            59:        Q
        !            60:        ;
        !            61: T404   ;PROCESS BLOCKS
        !            62:        ;    :.404
        !            63:        ;    :BLOCK NAME^
        !            64:        N DIFR1,DIFR2,D1,D2
        !            65:        S D1=0
        !            66:        F  S D1=$O(@DIFRTRT@(40,D1)) Q:'D1  I $D(^(D1,0)) S DIFR1=+$P(^(0),U,2) D
        !            67:        .I $D(^DIST(.404,DIFR1,0)) D
        !            68:        ..S $P(@DIFRTRT@(40,D1,0),U,2)=$P(^DIST(.404,DIFR1,0),U)
        !            69:        ..M @DIFRTA@(.404,DIFR1)=^DIST(.404,DIFR1)
        !            70:        ..K @DIFRTA@(.404,DIFR1,40,"B"),^("C"),^("D")
        !            71:        ..Q
        !            72:        .S D2=0
        !            73:        .F  S D2=$O(@DIFRTRT@(40,D1,40,D2)) Q:'D2  I $D(^(D2,0)) S DIFR2=+^(0) D
        !            74:        ..I $D(^DIST(.404,DIFR2)) D
        !            75:        ...S $P(@DIFRTRT@(40,D1,40,D2,0),U)=$P(^DIST(.404,DIFR2,0),U)
        !            76:        ...M @DIFRTA@(.404,DIFR2)=^DIST(.404,DIFR2)
        !            77:        ...K @DIFRTA@(.404,DIFR2,40,"B"),^("C"),^("D")
        !            78:        ...Q
        !            79:        ..Q
        !            80:        .Q
        !            81:        Q
        !            82:        ;
        !            83: DIALOG ;
        !            84:        Q:'$D(@DIFRTRT@(0))  K ^(4),^(3,"B")
        !            85:        Q:$G(DIFRF)'>0
        !            86:        S:DIFRF DIFRF=$P($G(^DIC(9.4,DIFRF,0)),"^"),$P(@DIFRTRT@(0),"^",4)=DIFRF
        !            87:        Q