Return to DIFGGSB1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFGGSB1.m, revision 1.1

1.1     ! snw         1: DIFGGSB1       ;SFISC/XAK,EDE(OHPRD)-FILEGRAM SPECIAL BLOCK PART 2 ;2/3/93  12:46 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: BODY   S DIFGSB(DILL,"SPSPEC")=0
        !             5:        I $D(DIFG(DILL,"FUNC")),"AL"[DIFG(DILL,"FUNC") I 1
        !             6:        E  I $D(DIFG(DILL,"NOKEY"))
        !             7:        E  D SPSPEC^DIFGGSB2
        !             8:        Q:DIFGSB(DILL,"SPSPEC")
        !             9:        D P01
        !            10:        D SPEC
        !            11:        D IDENT
        !            12:        Q
        !            13:        ;
        !            14: P01    ; .01 FIELD WHEN IT IS A POINTER
        !            15:        Q:$P(^DD(DIFG(DILL,"FILE"),.01,0),U,2)'["P"
        !            16:        S DIFGSB(DILL,"FLD")=.01
        !            17:        D SETXY
        !            18:        Q:Y=""
        !            19:        D PTRCHK^DIFGGSB2
        !            20:        Q
        !            21:        ;
        !            22: SPEC   ; SPECIFIERS
        !            23:        S DIFGSB(DILL,"SBT")="SPECIFIER:",%=""
        !            24:        F DIFGSB(DILL,"FLD")=0:0 D SPEC2 Q:DIFGSB(DILL,"FLD")'=+DIFGSB(DILL,"FLD")  S %=%_$S(%="":DIFGSB(DILL,"FLD"),1:";"_DIFGSB(DILL,"FLD"))
        !            25:        I '$D(DIFG(DILL,"MUL")) S DR=% D:%'="" FIELDS I 1
        !            26:        E  S DR(DIFG(DILL,"FILE"))=% D:%'="" FIELDS
        !            27:        K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
        !            28:        I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
        !            29:        K % Q
        !            30:        ;
        !            31: SPEC2  S DIFGSB(DILL,"FLD")=$O(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"FLD")))
        !            32:        Q
        !            33:        ;
        !            34: IDENT  ; IDENTIFIERS
        !            35:        S DIFGSB(DILL,"SBT")="IDENTIFIER:",%=""
        !            36:        F DIFGSB(DILL,"FLD")=0:0 D IDENT2 Q:DIFGSB(DILL,"FLD")'=+DIFGSB(DILL,"FLD")  D:'$D(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"FLD"))) IDENT3
        !            37:        I '$D(DIFG(DILL,"MUL")) S DR=% D:%'="" FIELDS I 1
        !            38:        E  S DR(DIFG(DILL,"FILE"))=% D:%'="" FIELDS
        !            39:        K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
        !            40:        I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
        !            41:        K %
        !            42:        Q
        !            43:        ;
        !            44: IDENT2 S DIFGSB(DILL,"FLD")=$O(^DD(DIFG(DILL,"FILE"),0,"ID",DIFGSB(DILL,"FLD")))
        !            45:        Q
        !            46:        ;
        !            47: IDENT3 S %=%_$S(%="":DIFGSB(DILL,"FLD"),1:";"_DIFGSB(DILL,"FLD"))
        !            48:        Q
        !            49:        ;
        !            50: FIELDS I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) D DRFIX
        !            51:        I '$D(DIFG(DILL,"MUL")) Q:DR=""
        !            52:        E  Q:DR(DIFG(DILL,"FILE"))=""
        !            53:        K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
        !            54:        S:'$D(DIFG(DILL,"MUL")) DIC=DIFG(DILL,"FILE"),DA=DIFG(DILL,"FE")
        !            55:        S DIQ(0)="N" D EN^DIQ1 K DIQ
        !            56:        F DIFGSB(DILL,"FLD")=0:0 D FIELDS2 Q:DIFGSB(DILL,"FLD")'=+DIFGSB(DILL,"FLD")  S X=^(DIFGSB(DILL,"FLD")) D FIELDS3
        !            57:        Q
        !            58:        ;
        !            59: DRFIX  ; ADJUST DR FOR MODIFIED/DELETED VALUES
        !            60:        NEW T
        !            61:        I '$D(DIFG(DILL,"MUL")) S T=DR
        !            62:        E  S T=DR(DIFG(DILL,"FILE"))
        !            63:        F %=1:1 S X=$P(T,";",%) Q:X=""  S %(X)="" I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),X)) K %(X) S DIFGSB(DILL,"FLD")=X,X=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),X) D DRFIX2
        !            64:        S (T,X)=""
        !            65:        F %=0:0 S X=$O(%(X)) Q:X=""  S T=T_$S(T="":"",1:";")_X
        !            66:        I '$D(DIFG(DILL,"MUL")) S DR=T
        !            67:        E  S DR(DIFG(DILL,"FILE"))=T
        !            68:        Q
        !            69:        ;
        !            70: DRFIX2 NEW %,DR,T
        !            71:        D FIELDS3
        !            72:        Q
        !            73:        ;
        !            74: FIELDS2        S DIFGSB(DILL,"FLD")=$O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFGSB(DILL,"FLD")))
        !            75:        Q
        !            76:        ;
        !            77: FIELDS3        Q:X=""
        !            78:        D SETXY
        !            79:        K F,N,P,W
        !            80:        S V=DIFGSB(DILL,"SBT")_$P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,1)_U_$S(DIFG("PARM")["N":DIFGSB(DILL,"FLD"),1:"")
        !            81:        S:DIFGSB(DILL,"SBT")["KEY" V=V_U_$P(DIFGSB(DILL,"SPSPEC"),U,2)
        !            82:        S V=V_"="_X
        !            83:        D INCSET^DIFGGU
        !            84:        D:Y'="" PTRCHK^DIFGGSB2
        !            85:        K X,Y
        !            86:        Q
        !            87: SETXY  ; If previously looked up pointer set @LINK
        !            88:        S Y=""
        !            89:        Q:$P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,2)'["P"
        !            90:        S F=+$P($P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,2),"P",2),W=$P(^(0),U,4),N=$P(W,";",1),P=$P(W,";",2)
        !            91:        I $D(DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFGSB(DILL,"FLD"),"P")) S Y=DIFGGU(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFGSB(DILL,"FLD"),"P") I 1
        !            92:        E  S Y=$P(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",N)"),U,P)
        !            93:        I $D(^UTILITY("DIFGLINK",$J,F,Y)) S X="@"_^UTILITY("DIFGLINK",$J,F,Y),Y="" Q
        !            94:        S ^UTILITY("DIFGLINK",$J)=$S($D(^UTILITY("DIFGLINK",$J))#2:^UTILITY("DIFGLINK",$J)+1,1:1)
        !            95:        S ^UTILITY("DIFGLINK",$J,F,Y)=^UTILITY("DIFGLINK",$J)
        !            96:        S Y="@"_^UTILITY("DIFGLINK",$J)
        !            97:        Q