Return to DIFROMS5.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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