Return to DIFROMSP.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFROMSP.m, revision 1.1

1.1     ! snw         1: DIFROMSP       ;SFISC/DCL-DIFROM SERVER POINTER LIST;02:58 PM  9 Sep 1994;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: POINTERS(DIFRFILE,DIFRFLG,DIFRPTA)     ;FILENUMBER, POINTER X-REF TARGET ARRAY ROOT
        !             6:        ;FILE, FLAGS, TARGET ARRAY
        !             7:        S DIFRFLG=$G(DIFRFLG)
        !             8:        N DIFRDDNS,DIFRALL
        !             9:        S DIFRALL=DIFRFLG["A"
        !            10:        D FP(DIFRFILE,"","DIFRDDNS")  ;ALL DD#s FOR FILE IN DIFRDDNS array
        !            11:        S DIFRDDNS=0
        !            12:        F  S DIFRDDNS=$O(DIFRDDNS(DIFRFILE,DIFRDDNS)) Q:DIFRDDNS'>0  D
        !            13:        .D P(DIFRDDNS,DIFRFLG,$NA(@DIFRPTA@("P",DIFRFILE)))  ;set "P" x-refs in target array
        !            14:        .Q
        !            15:        Q
        !            16:        ;
        !            17: FP(DIFRFILE,DIFRFLG,DIFRTA)    ;FILENUMBER, TARGET ARRAY ROOT FOR SUB DD NRS
        !            18:        ;FILE, FLAGS, TARGET ARRAY
        !            19:        N DIFRFD,DIFRFE,DIFRFW,DIFRNM,DIFRX
        !            20:        S DIFRFW=$G(DIFRFLG)'["W"
        !            21: F      S @DIFRTA@(DIFRFILE,DIFRFILE)=$O(^DD(DIFRFILE,0,"NM",""))_"  "_$S($D(^DIC(DIFRFILE,0)):"(File-top level)",1:"(sub-file)"),DIFRFE=0
        !            22: E      F  S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0  D
        !            23:        .S DIFRFD=0
        !            24:        .F  S DIFRFD=$O(^DD(DIFRFE,"SB",DIFRFD)) Q:DIFRFD'>0  D
        !            25:        ..I DIFRFW,$P(^DD(DIFRFD,.01,0),"^",2)["W" Q
        !            26:        ..I DIFRFILE-DIFRFE!'$D(DIFRFA) S @DIFRTA@(DIFRFILE,DIFRFD)=$O(^DD(DIFRFD,0,"NM",""))_"  (sub-file)"
        !            27:        ..Q
        !            28:        .Q
        !            29:        Q
        !            30:        ;
        !            31: P(DIFRPDD,DIFRFLG,DIFRPTA)     ;DIFRPDD=DD#,DIFRPTA=TARGET ARRAY BY VALUE TO SET "P" X-REF
        !            32:        ;FILE/SUB-DD#,FLAGS,TARGET_ARRAY
        !            33:        N X,Y,PN,PIDF,PFILE,DIFRALL
        !            34:        S DIFRFLG=$G(DIFRFLG),DIFRALL=DIFRFLG["A"
        !            35:        I $G(U)'="^" N U S U="^"
        !            36:        S X=$S(DIFRALL:0,1:.01)
        !            37:        F  S X=$O(^DD(DIFRPDD,X)) Q:X'>0  I $D(^(X,0)),'$P(^(0),U,2),$P(^(0),U,2)["P" S Y=^(0) D
        !            38:        .I 'DIFRALL,$D(^DD(DIFRPDD,0,"IX",X)) Q
        !            39:        .S PN=0
        !            40:        .S @DIFRPTA@(DIFRPDD,X,PN)=U_$P(Y,U,3)
        !            41:        .F  Q:$P($G(^DD(+$P($P(Y,U,2),"P",2),.01,0)),U,2)'["P"  S Y=^(0) D
        !            42:        ..S PN=PN+1
        !            43:        ..S @DIFRPTA@(DIFRPDD,X,PN)=U_$P(Y,U,3)
        !            44:        ..Q
        !            45:        .S PIDF=0,PFILE=+$P($P(Y,U,2),"P",2)
        !            46:        .F  S PIDF=$O(^DD(PFILE,0,"ID",PIDF)) Q:PIDF'>0  D
        !            47:        ..S @DIFRPTA@(DIFRPDD,X,PN,"ID",PIDF)=""
        !            48:        ..Q
        !            49:        .;HERE FIND ALL REQUIRED ID OR ALL ID FOR POINTED TOO FILE
        !            50:        .;AND LIST IN @DIFRPTA@(DIFRPDD,X,PN,"ID",FILEDNUMBER)
        !            51:        .Q
        !            52:        Q
        !            53:        ;
        !            54: PGL(DIFRFILE,DIFRFLG,DIFRTA)   ;  RETURN GL NODES FOR POINTERS IN TARGET ARRAY
        !            55:        ;FILE,FLAGS,TARGET ARRAY
        !            56:        N DIFR,DIFRD,DIFRF,DIFRPGL,DIFRX
        !            57:        Q:'$D(^DD(DIFRFILE))
        !            58:        Q:$G(DIFRTA)']""
        !            59:        D FSF(DIFRFILE,"","DIFRPGL")
        !            60:        S (DIFR,DIFRD)=0
        !            61:        F  S DIFRD=$O(DIFRPGL(DIFRFILE,DIFRD)) Q:DIFRD'>0  D
        !            62:        .S DIFRF=.01  ;Dont select .01 fields
        !            63:        .F  S DIFRF=$O(^DD(DIFRD,DIFRF)) Q:DIFRF'>0  I $D(^(DIFRF,0)) S DIFRX=^(0) D
        !            64:        ..Q:$P(DIFRX,"^",2)  ;Don't select Multiple/WP fields
        !            65:        ..I $D(^DD(DIFRD,0,"ID",DIFRF)) Q  ;Don't select IDENTIFIER fields
        !            66:        ..I $P(DIFRX,"^",2)["P"!($P(DIFRX,"^",2)["V") S @DIFRTA@("PGL",DIFRD,$P($P(DIFRX,"^",4),";"),$P($P(DIFRX,"^",4),";",2),DIFRF)=DIFRX Q
        !            67:        ..;SEND WHOLD NODE NOT $P(DIFRX,"^",2) Q
        !            68:        ..Q
        !            69:        .Q
        !            70:        Q
        !            71: TP(DIFRFILE,DIFRFLG,DIFRTA)    ; $$ Extrinsic Function - Test for Pointers OR Variable Pointers
        !            72:        ;Returns 1 or 0, if pointers in file
        !            73:        ;FILE,FLAGS,TARGET ARRAY
        !            74:        ;If target array exist the entire list of fields being exported will be
        !            75:        ;in array
        !            76:        N DIFR,DIFRTMP,DIFRD,DIFRF,DIFRX
        !            77:        S DIFRX=$G(DIFRTA)]""
        !            78:        D FSF(DIFRFILE,"","DIFRTMP")
        !            79:        S (DIFR,DIFRD)=0
        !            80:        F  S DIFRD=$O(DIFRTMP(DIFRFILE,DIFRD)) Q:DIFRD'>0  D  Q:DIFR
        !            81:        .S DIFRF=.01  ; Do not include .01 fields
        !            82:        .F  S DIFRF=$O(^DD(DIFRD,DIFRF)) Q:DIFRF'>0  I $D(^(DIFRF,0)),'$P(^(0),"^",2),($P(^(0),"^",2)["P"!($P(^(0),"^",2)["V")),'$D(^DD(DIFRD,0,"ID",DIFRF)) S:'DIFRX DIFR=1 Q:DIFR  D
        !            83:        ..S:DIFRX @DIFRTA@(DIFRD,DIFRF)=$S($P(^DD(DIFRD,DIFRF,0),"^",2)["P":"P",1:"V")
        !            84:        ..Q
        !            85:        .Q
        !            86:        Q:DIFRX $D(@DIFRTA)>9
        !            87:        Q DIFR
        !            88:        ;
        !            89: TL(DIFRFILE,DIFRFLG,DIFRSA)    ; $$ Extrinsic Function - Test for local fields
        !            90:        ;FILE,FLAGS,SOURCE_ARRAY - compares local DD with Transport DD
        !            91:        ;Returns 1 or 0, if local changes exist
        !            92:        ;RUN THIS AFTER DD IS INSTALLED ON TARGET SITE
        !            93:        N DIFR,DIFRD,DIFRF,DIFRTMP
        !            94:        D FSF(DIFRFILE,"","DIFRTMP")
        !            95:        S (DIFR,DIFRD)=0
        !            96:        F  S DIFRD=$O(DIFRTMP(DIFRFILE,DIFRD)) Q:DIFRD'>0  D  Q:DIFR
        !            97:        .S DIFRF=0
        !            98:        .F  S DIFRF=$O(^DD(DIFRD,DIFRF)) Q:DIFRF'>0  I $D(^(DIFRF,0)),'$D(@DIFRSA@("^DD",DIFRFILE,DIFRD,DIFRF,0)) S DIFR=1 Q
        !            99:        .Q
        !           100:        Q DIFR
        !           101:        ;
        !           102: FSF(DIFRFILE,DIFRFLG,DIFRTA)   ;File-Sub-File List
        !           103:        ;FILE, FLAGS, TARGET ARRAY
        !           104:        N DIFRFD,DIFRFE,DIFRFW,DIFRNM,DIFRX
        !           105:        S DIFRFW=$G(DIFRFLG)'["W"
        !           106:        S @DIFRTA@(DIFRFILE,DIFRFILE)="",DIFRFE=0
        !           107:        F  S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0  D
        !           108:        .S DIFRFD=0
        !           109:        .F  S DIFRFD=$O(^DD(DIFRFE,"SB",DIFRFD)) Q:DIFRFD'>0  D
        !           110:        ..I DIFRFW,$P(^DD(DIFRFD,.01,0),"^",2)["W" Q
        !           111:        ..I DIFRFILE-DIFRFE!'$D(DIFRFA) S @DIFRTA@(DIFRFILE,DIFRFD)=""
        !           112:        ..Q
        !           113:        .Q
        !           114:        Q