Return to DDSZ2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDSZ2.m, revision 1.1

1.1     ! snw         1: DDSZ2  ;SFISC/MKO-LOAD SCR, NAV, AND ORDER INFO ;11:01 AM  29 Jul 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: EN(SC,N,O,RNAV)        ;
        !             5:        ;Input:
        !             6:        ;  DDSPG
        !             7:        ;  DDSREFS
        !             8:        ;
        !             9:        D SCR(.SC),NAV(.N),ORD(.O)
        !            10:        D:$D(RNAV) RNAV(.RNAV,.O)
        !            11:        Q
        !            12:        ;
        !            13: SCR(SC)        ;Move image from SC to global
        !            14:        N C,P,R,S
        !            15:        Q:'$D(SC)
        !            16:        S R=0 F  S R=$O(SC(R)) Q:'R  D
        !            17:        . F C=1:1 Q:$E(SC(R),C)'=" "
        !            18:        . S @DDSREFS@("X",DDSPG,R-1,C-1)=$TR($E(SC(R),C,999),$C(0)," ")
        !            19:        . I $D(SC(R))=11 D
        !            20:        .. S S="",P=0
        !            21:        .. F  S P=$O(SC(R,P)) Q:'P  S S=S_(P-C+1)_";"_(SC(R,P)-C+1)_";U"_U
        !            22:        .. S:S?.E1"^" S=$E(S,1,$L(S)-1)
        !            23:        .. S:S]"" @DDSREFS@("X",DDSPG,R-1,C-1,"A")=S
        !            24:        Q
        !            25:        ;
        !            26: NAV(N) ;
        !            27:        N B,D1,D2,F,LN
        !            28:        S N(9999,1)="0,0"
        !            29:        ;
        !            30:        S D1="" F  S D1=$O(N(D1)) Q:D1=""  D
        !            31:        . S D2="" F  S D2=$O(N(D1,D2)) Q:D2=""  D
        !            32:        .. S F=$P(N(D1,D2),","),B=$P(N(D1,D2),",",2),LN=""
        !            33:        .. D NAV1(.N,D1,D2,.LN)
        !            34:        .. S @DDSREFS@(DDSPG,B,F,"N")=LN
        !            35:        .. S:$D(DDSMUL(B,F)) $P(@DDSREFS@(DDSPG,B,F,"N"),U,11)=1
        !            36:        Q
        !            37:        ;
        !            38: NAV1(N,D1,D2,LN)       ;Setup "N" for navigation
        !            39:        N E1,E2,I
        !            40:        ;
        !            41:        S E1=$S($O(N(D1),-1)]"":$O(N(D1),-1),1:$O(N(""),-1))
        !            42:        S E2=D2
        !            43:        I $D(N(E1,E2))[0 S E2=$S($O(N(E1,E2),-1)]"":$O(N(E1,E2),-1),1:$O(N(E1,E2)))
        !            44:        I E1]"",E2]"" S $P(LN,U)=N(E1,E2)
        !            45:        ;
        !            46:        S E1=$S($O(N(D1))]"":$O(N(D1)),1:$O(N("")))
        !            47:        S E2=D2
        !            48:        I $D(N(E1,E2))[0 S E2=$S($O(N(E1,E2),-1)]"":$O(N(E1,E2),-1),1:$O(N(E1,E2)))
        !            49:        I E1]"",E2]"" S $P(LN,U,2)=N(E1,E2)
        !            50:        ;
        !            51:        S E1=D1,E2=$O(N(D1,D2))
        !            52:        I E2="" S E1=$S($O(N(E1))]"":$O(N(E1)),1:$O(N(""))),E2=$O(N(E1,""))
        !            53:        I E1]"",E2]"" S $P(LN,U,3)=N(E1,E2)
        !            54:        ;
        !            55:        S E1=D1,E2=$S($O(N(E1,D2),-1)]"":$O(N(E1,D2),-1),1:"")
        !            56:        I E2="" S E1=$S($O(N(E1),-1)]"":$O(N(E1),-1),1:$O(N(""),-1)),E2=$S($O(N(E1,""),-1)]"":$O(N(E1,""),-1),1:"")
        !            57:        I E1]"",E2]"" S $P(LN,U,4)=N(E1,E2)
        !            58:        ;
        !            59:        F I=1:1:4 S:$P($P(LN,U,I),",",2)=B!'$P($P(LN,U,I),",",2) $P(LN,U,I)=+$P(LN,U,I)
        !            60:        Q
        !            61:        ;
        !            62: ORD(O) ;Setup field order info
        !            63:        N B,BO,BP,F,FO,FP
        !            64:        S (BO,FO)="" F  S BO=$O(O(BO)) Q:BO=""  S FO=$O(O(BO,"")) Q:FO]""
        !            65:        S:FO="" BO=$O(O(""))
        !            66:        S B=+$G(O(+BO)),F=+$G(O(+BO,+FO))
        !            67:        S @DDSREFS@(DDSPG,"FIRST")=F_","_B
        !            68:        ;
        !            69:        S (BP,FP)=0
        !            70:        S BO="" F  S BO=$O(O(BO)) Q:BO=""  D
        !            71:        . S B=+O(BO),F=0
        !            72:        . S FO=$O(O(BO,"")) S:FO]"" F=O(BO,FO)
        !            73:        . S $P(@DDSREFS@(DDSPG,B),U,9)=F
        !            74:        . S:$P(O(BO),U,2)]"" $P(@DDSREFS@(DDSPG,B),U,10)=$S($P(O(BO),U,2)="FIRST":F,1:$P(O(BO),U,2))
        !            75:        . S FO="" F  S FO=$O(O(BO,FO)) Q:FO=""  D
        !            76:        .. S F=O(BO,FO)
        !            77:        .. S $P(@DDSREFS@(DDSPG,BP,FP,"N"),U,5)=F_$S(B'=BP:","_B,1:"")
        !            78:        .. S FP=F,BP=B
        !            79:        S $P(@DDSREFS@(DDSPG,BP,FP,"N"),U,5)=0
        !            80:        Q
        !            81:        ;
        !            82: RNAV(DDSRNAV,DDSO)     ;Setup nav and fo info for rep blocks
        !            83:        N DDSBO,DDSN,B,D1,D2,DN,F,F1,FO,LN,NX,RT
        !            84:        S DDSBO="" F  S DDSBO=$O(DDSRNAV(DDSBO)) Q:DDSBO=""  D
        !            85:        . ;N %X,%Y K DDSN S %X="DDSRNAV("_DDSBO_",",%Y="DDSN(" D %XY^%RCR
        !            86:        . K DDSN M DDSN=DDSRNAV(DDSBO)
        !            87:        . S D1="" F  S D1=$O(DDSN(D1)) Q:D1=""  D:$D(DDSN(D1))#2
        !            88:        .. S B=DDSN(D1)
        !            89:        .. S D2="" F  S D2=$O(DDSN(D1,D2)) Q:D2=""  D
        !            90:        ... S F=$P(DDSN(D1,D2),","),LN=""
        !            91:        ... D NAV1(.DDSN,D1,D2,.LN)
        !            92:        ... S $P(@DDSREFS@(DDSPG,B,F,"N"),U,6,9)=LN
        !            93:        . ;
        !            94:        . S B=+$G(DDSO(+DDSBO)) Q:'B
        !            95:        . S FO=$O(DDSO(DDSBO,"")) Q:FO=""
        !            96:        . S (F,F1)=DDSO(DDSBO,FO)
        !            97:        . F  S FO=$O(DDSO(DDSBO,FO)) Q:FO=""  D
        !            98:        .. S $P(@DDSREFS@(DDSPG,B,F,"N"),U,10)=DDSO(DDSBO,FO)
        !            99:        .. S F=DDSO(DDSBO,FO)
        !           100:        . S $P(@DDSREFS@(DDSPG,B,F,"N"),U,10)=F1_",+1"
        !           101:        . ;
        !           102:        . S DN=0
        !           103:        . S F=0 F  S F=$O(@DDSREFS@(DDSPG,B,F)) Q:DN=2!(F="")  D
        !           104:        .. S LN=$G(@DDSREFS@(DDSPG,B,F,"N")) Q:LN=""
        !           105:        .. S RT=$P(LN,U,3),NX=$P(LN,U,5)
        !           106:        .. S:RT[","!'RT DN=DN+1
        !           107:        .. S:NX[","!'NX DN=DN+1
        !           108:        . ;
        !           109:        . S F=0 F  S F=$O(@DDSREFS@(DDSPG,B,F)) Q:F=""  D
        !           110:        .. S $P(@DDSREFS@(DDSPG,B,F,"N"),U,3)=RT
        !           111:        .. S $P(@DDSREFS@(DDSPG,B,F,"N"),U,5)=NX
        !           112:        Q