Return to DIOU.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIOU.m, revision 1.1

1.1     ! snw         1: DIOU   ;SFISC/TKW-GENERIC FILEMAN CODE GENERATION UTILITIES ;12/20/94  11:12
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: BIJ(S,F,I,J)   ;BUILD I & J ARRAY.  S=(SUB)FILE#, F=FIELD#
        !             5:        N X,Y,% S X=0,(Y,J(0))=S F  Q:'$D(^DD(Y,0,"UP"))  S X=X+1,Y=^("UP")
        !             6:        I X=0 G X
        !             7:        F %=X:-1:1 S Y=$G(^DD(S,0,"UP")) Q:'Y  S I(S)=%,I(S,0)=Y,F=$O(^DD(Y,"SB",S,0)) Q:'F  S I(S,1)=$P($P($G(^DD(Y,F,0)),U,4),";"),S=Y
        !             8: X      S J=$G(^DIC(S,0,"GL")),I(S)=0
        !             9:        I $G(DCC)?1"^"1.A1"(".E,((J="")!($P(DCC,J,2)]"")) S J=DCC
        !            10:        Q
        !            11: GREF(I,J,F)    ;BUILD GLOBAL REFERENCE (I & J ARRAY FROM BIJ, CODE RETURNED IN F)
        !            12:        N %,Y S F="",%=J(0) F Y=I(%):-1 S F="D"_Y_F Q:'Y  S F=","_$G(I(%,1))_","_F,%=$G(I(%,0)) Q:%=""!('$D(^DD(+%)))
        !            13:        S F=$S($D(I(%,8)):I(%,8),1:J)_F Q
        !            14: GLRF(S,F,X,%)  ;BUILD GLOBAL REFERENCE (S=(SUB)FILE#,F=FIELD NO.,%=CLOSE PARENTHESIS, RETURN PIECE IN %, X=OUTPUT VARIABLE.)
        !            15:        Q:'$D(^DD($G(S),$G(F),0))  N I,J,K,L,Y D BIJ(S,F,.I,.J)
        !            16:        S X="",K=J(0) F Y=I(K):-1 S X="D"_Y_X Q:'Y  S L=$G(I(K,1)) S:L]""&(+$P(L,"E")'=L) L=$$QUOTE^DILIBF(L) S:L]"" X=","_L_","_X S K=+$G(I(K,0)) Q:'K
        !            17:        S X=J_X_"," Q:$G(%)=""
        !            18:        S %=$P($P(^DD(S,F,0),U,4),";",1) I %]"",+$P(%,"E")'=% S %=$$QUOTE^DILIBF(%)
        !            19:        S X=X_%_")",%=$P($P(^DD(S,F,0),U,4),";",2) Q
        !            20:        S %=$P(^DD(S,F,0),U,4),X=X_$P(%,";",1)_")",%=$P(%,";",2) Q
        !            21: GET(S,F,X,Y)   ;BUILD CODE TO EXTRACT FIELD.  S=FILE/SUBFILE#, F=FIELD#, X=LOCAL VARIABLE NAME WHERE FIELD WILL BE STORED.  CODE RETURNED IN Y
        !            22:        N % Q:'$D(^DD(+$G(S),+$G(F),0))  S %=^(0),%(2)=$G(^(2))
        !            23:        N P,DN,I,J
        !            24:        S P=1 D GLRF(S,F,.Y,.P)
        !            25:        I P S DN="$P(",P="),U,"_P_")"
        !            26:        E  G:$E(P)'="E" CAL S DN="$E(",P="),"_$E(P,2,9)_")"
        !            27:        S Y="S "_X_"="_DN_"$G("_Y_P
        !            28:        I %(2)]"",$P(%,U,2)["O",$P(%,U,2)'["D" S Y=Y_",Y="_X_" "_%(2)_" S "_X_"=Y"
        !            29:        Q
        !            30: CAL    S Y=$P(%,U,5,99)_" S "_X_"=X" Q
        !            31:        ;
        !            32: DTYP(S,F,Y)    ;RETURN DATA TYPES(S) FOR A FIELD
        !            33:        K Y S Y=""
        !            34:        I $G(F)=.001,$G(^DD(+$G(S),F,0))="" S Y=2 Q
        !            35: D2     Q:$G(^DD(+$G(S),+$G(F),0))=""  N %,%X,%Y,X,I,J,DITYP
        !            36:        S %=$P(^(0),U,2),%(1)=$P(^(0),U,3),%(4)=$P(^(0),U,5,99),DITYP=""
        !            37:        I '% S I="" F  S I=$O(^DI(.81,"C",I)) Q:I=""  I %[I S DITYP=$O(^(I,0)) Q
        !            38:        I DITYP="",% D  G:'DITYP D2
        !            39:        . I $P($G(^DD(+%,.01,0)),U,2)["W" S DITYP=5 Q
        !            40:        . S S=+%,F=.01 K % Q
        !            41:        S:Y="" Y=DITYP
        !            42:        I DITYP=1 S Y("D")="",%(4)=$P($P(%(4),"%DT=",2),"""",2) S:%(4)["T"!(%(4)["R")!(%(4)="") Y("D")=Y("D")_"T" S:%(4)["S" Y("D")=Y("D")_"S" G QD
        !            43:        I DITYP,"2,4,5,9"[DITYP G QD
        !            44:        Q:Y=""
        !            45:        I DITYP=6 S Y("T")=$S(%["D":1,%["B":2,%?.E1"J".N1","1N.E:2,1:4) Q
        !            46: P      I DITYP=7 S I=+$P(%,"P",2),%(2)="Y(" D Y S S=I,F=.01 K % G D2
        !            47: V      I DITYP=8 S X=0 D V2 Q
        !            48: S      I DITYP=3 F I=1:1 S X=$P(%(1),";",I),X(1)=$P(X,":"),X=$P(X,":",2) Q:X=""!(X(1)="")  S Y("S","I",X(1))=X,Y("S","E",X)=X(1)
        !            49: QD     I $O(Y(-1)) S Y("T")=DITYP
        !            50:        Q
        !            51: Y      S %(3)=$O(@(%(2)_"0)")) I %(3)]"",%(3)'="T" S %(2)=%(2)_%(3)_"," G Y
        !            52:        S %(2)=%(2)_I,@(%(2)_")")="" Q
        !            53: V2     S X=$O(^DD(S,F,"V",X)) Q:'X  S I=$P($G(^DD(S,F,"V",X,0)),U) G:'I V2
        !            54:        S:'$D(Y("V"_X)) Y("V"_X)="" S %(2)="Y("_"""V"_X_"""," D Y
        !            55:        D DTYP(.I,.01,.J)
        !            56:        I J>0 S (Y("T"),Y("V"_X,"T"))=$S($G(J("T"))]"":J("T"),1:J) K J("T") S %X="J(",%Y=%(2)_"," D %XY^%RCR
        !            57:        K %,J G V2