Return to DIFROMSU.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

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

1.1     ! snw         1: DIFROMSU       ;SCISC/DCL-DIFROM SERVER BUILD "FIA" SUBSCRIPTS IN TRANSPORT ARRAY;03:24 PM  14 Sep 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: FIA(DIFRFILE,DIFRFLG,DIFRPFL,DIFRTAR,DIFR222,DIFR223,DIFRDSCR,DIFRVER,DIFRMSGR)        ;
        !             5:        ;FILE,FLAGS,PARTIAL_FILE_LIST,TARGET_ARRAY_ROOT,ANSWERS,DD_SCREEN,DATA_SCREEN,VERSION,MSG_ARRAY
        !             6:        I '$D(DIQUIET) N DIQUIET S DIQUIET=1
        !             7:        I '$D(DIFM) N DIFM S DIFM=1
        !             8:        I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
        !             9:        N DIFRFD,DIFRFE,DIFRX,FIELD,FIELDNR,DIFRTA,DIFRP,DIFR00
        !            10:        S DIFRTA=$NA(@DIFRTAR@("FIA"))
        !            11:        I $G(DIFRFILE)'>0 D BLD^DIALOG(9542) Q
        !            12:        I '$D(^DIC(DIFRFILE)) D BLD^DIALOG(9539,DIFRFILE) Q
        !            13:        I $P($G(DIFR222),"^",3)'="p" G F
        !            14:        I $G(DIFRPFL)']"" G F
        !            15:        I $D(@DIFRPFL)'>9 G F
        !            16:        G F:$O(@DIFRPFL@(0))'>0
        !            17:        N DIFRDDC,DIFRFLDC,DIFRTMP
        !            18:        K ^TMP("FIA",$J)
        !            19:        S DIFRDDC=0,DIFRTMP=$NA(^TMP("FIA",$J))
        !            20:        M @DIFRTMP=@DIFRPFL
        !            21:        F  S DIFRDDC=$O(@DIFRTMP@(DIFRFILE,DIFRDDC)) Q:DIFRDDC'>0  D
        !            22:        .I '$D(^DD(DIFRDDC)) K @DIFRTMP@(DIFRFILE,DIFRDDC) D BLD^DIALOG(9540,DIFRDDC) Q
        !            23:        .I '$O(@DIFRTMP@(DIFRFILE,DIFRDDC,0)) D  Q
        !            24:        ..Q:@DIFRTMP@(DIFRFILE,DIFRDDC)="SUB"
        !            25:        ..D SB^DIFROMSS(DIFRDDC,"W",$NA(@DIFRTMP@(DIFRFILE)),"SUB")
        !            26:        ..Q
        !            27:        .S DIFRFLDC=0
        !            28:        .F  S DIFRFLDC=$O(@DIFRTMP@(DIFRFILE,DIFRDDC,DIFRFLDC)) Q:DIFRFLDC'>0  D
        !            29:        ..I '$D(^DD(DIFRDDC,DIFRFLDC,0)) K @DIFRTMP@(DIFRFILE,DIFRDDC,DIFRFLDC) D  Q
        !            30:        ...N DIFRX S DIFRX(1)=DIFRFLDC,DIFRX(2)=DIFRDDC
        !            31:        ...D BLD^DIALOG(9541,.DIFRX)
        !            32:        ...Q
        !            33:        ..I $P(^DD(DIFRDDC,DIFRFLDC,0),"^",2) S DIFRX=$P(^DD(+$P(^(0),"^",2),.01,0),"^",2) D
        !            34:        ...I DIFRX["W" S @DIFRTMP@(DIFRFILE,+$P(^DD(DIFRDDC,DIFRFLDC,0),"^",2))=0 Q
        !            35:        ...K @DIFRTMP@(DIFRFILE,DIFRDDC,DIFRFLDC)
        !            36:        ...Q
        !            37:        ..Q
        !            38:        .Q
        !            39:        ;
        !            40:        M @DIFRTA@(DIFRFILE)=@DIFRTMP@(DIFRFILE)
        !            41:        K @DIFRTMP
        !            42:        ;
        !            43:        I $D(@DIFRTA@(DIFRFILE,DIFRFILE))=1 G F
        !            44:        S @DIFRTA@(DIFRFILE,DIFRFILE)=1,DIFRFE=DIFRFILE
        !            45:        ;F  S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0  S:$P(^DD(DIFRFE,.01,0),"^",2)'["W" @DIFRTA@(DIFRFILE,DIFRFE,.01)=0
        !            46:        F  S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0  D
        !            47:        .S @DIFRTA@(DIFRFILE,DIFRFE)=$D(@DIFRTA@(DIFRFILE,DIFRFE))>9
        !            48:        .N DIFRX,DIFRY
        !            49:        .S DIFRY=$$UP^DIQGU(DIFRFE,.DIFRX)
        !            50:        .Q:'$D(DIFRX)!(+$G(DIFRX(-1))=DIFRFILE)
        !            51:        .K DIFRX($O(DIFRX("")))
        !            52:        .M @DIFRTAR@("UP",DIFRFILE,DIFRFE)=DIFRX
        !            53:        .Q
        !            54:        S DIFRFE=DIFRFILE
        !            55:        F  S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0  D:'^(DIFRFE)!($D(@DIFRTA@(DIFRFILE,DIFRFE,.01)))
        !            56:        .Q:'$D(^DD(DIFRFE,0,"UP"))
        !            57:        .N DIFRUP,DIFRFLD
        !            58:        .S DIFRUP=^DD(DIFRFE,0,"UP"),DIFRFLD=$O(^DD(DIFRUP,"SB",DIFRFE,0))
        !            59:        .Q:$G(@DIFRTA@(DIFRFILE,DIFRUP))=0!($D(@DIFRTA@(DIFRFILE,DIFRUP,DIFRFLD)))
        !            60:        .S @DIFRTA@(DIFRFILE,DIFRUP,DIFRFLD)=""
        !            61:        .Q:$D(@DIFRTA@(DIFRFILE,DIFRUP))#2
        !            62:        .S @DIFRTA@(DIFRFILE,DIFRUP)=1
        !            63:        .Q
        !            64:        ;
        !            65:        G G
        !            66: F      S @DIFRTA@(DIFRFILE,DIFRFILE)=0,DIFRFE=0
        !            67:        S:$P(DIFR222,"^",3)'="f" $P(DIFR222,"^",3)="f"
        !            68: E      F  S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0  D
        !            69:        .S DIFRFD=0
        !            70:        .F  S DIFRFD=$O(^DD(DIFRFE,"SB",DIFRFD)) Q:DIFRFD'>0  S @DIFRTA@(DIFRFILE,DIFRFD)=0
        !            71:        .Q
        !            72: G      S @DIFRTA@(DIFRFILE)=$P(^DIC(DIFRFILE,0),"^")
        !            73:        S (DIFR00,@DIFRTA@(DIFRFILE,0))=^DIC(DIFRFILE,0,"GL")
        !            74:        S @DIFRTA@(DIFRFILE,0,0)=$P(@(DIFR00_"0)"),"^",2)
        !            75:        S @DIFRTA@(DIFRFILE,0,1)=$G(DIFR222)
        !            76:        S @DIFRTA@(DIFRFILE,0,10)=$G(DIFR223)
        !            77:        S @DIFRTA@(DIFRFILE,0,11)=$G(DIFRDSCR)
        !            78:        S @DIFRTA@(DIFRFILE,0,"RLRO")=$$ROOT($P(DIFR222,"^",6))
        !            79:        I $G(DIFRVER)]"" S @DIFRTA@(DIFRFILE,0,"VR")=DIFRVER
        !            80: FE     I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
        !            81:        Q
        !            82:        ;
        !            83: ERR501(DIFRFILE,DIFRFLD)       ;  501 Errors
        !            84:        N DIFRERRX
        !            85:        S DIFRERRX("FILE")=DIFRFILE,DIFRERRX(1)=DIFRFLD
        !            86:        D BLD^DIALOG(501,.DIFRERRX)
        !            87:        Q
        !            88: ROOT(IEN)      ;Create root from DIBT(ien
        !            89:        ;
        !            90:        I $G(IEN)>0,$D(^DIBT(IEN,1))>9 Q "^DIBT("_IEN_",1)"
        !            91:        I $G(IEN)]"" S IEN=$O(^DIBT("B",IEN,"")) Q:IEN>0 $$ROOT(IEN)
        !            92:        Q ""