Return to DIFGG2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFGG2.m, revision 1.1

1.1     ! snw         1: DIFGG2 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FIELDS ;2/4/93  10:59 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: START  K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
        !             5:        D DRS
        !             6:        K S,V,X,DIFG2
        !             7:        Q
        !             8:        ;
        !             9: DRS    S DR=""
        !            10:        I $P(^DIPT(DIFGT,1,DIFGI,0),U,8) F DIFG2=.001:0 S DIFG2=$O(^DD(DIFG(DILL,"FILE"),DIFG2)) Q:DIFG2'>0  S %=$P(^(DIFG2,0),U,2) I $S('%:%'["C",1:$P(^DD(+%,.01,0),U,2)["W") S DR=DR_DIFG2_";" I $L(DR)>200 D DR S DR=""
        !            11:        F DIFG2=0:0 S DIFG2=$O(^DIPT(DIFGT,1,DIFGI,"F",DIFG2)) Q:DIFG2'=+DIFG2  I $D(^(DIFG2,0)) S DR=DR_^(0)_";" I $L(DR)>200 D DR S DR=""
        !            12:        D DR:DR]"" Q
        !            13:        ;
        !            14: EN     ;
        !            15: DR     I '$D(DIFG(DILL,"MUL")) S DIC=DIFG(DILL,"FILE"),DA=DIFG(DILL,"FE")
        !            16:        S DIQ(0)="N" D EN^DIQ1 K DIQ
        !            17:        I $D(DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) F DIFG2(DILL,"FLD")=0:0 S DIFG2(DILL,"FLD")=$O(DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))) Q:'DIFG2(DILL,"FLD")  D
        !            18:        . NEW VAL
        !            19:        . S VAL=DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))
        !            20:        . S ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))=$S(VAL]"":VAL,1:"^")
        !            21:        . Q
        !            22:        F DIFG2(DILL,"FLD")=0:0 D DR2 Q:DIFG2(DILL,"FLD")'=+DIFG2(DILL,"FLD")  S V=^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD")) D FIELD
        !            23:        I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
        !            24:        K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE")),DIFGGF(DIFG(DILL,"FILE"))
        !            25:        Q
        !            26:        ;
        !            27: DR2    S DIFG2(DILL,"FLD")=$O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))) Q:DIFG2(DILL,"FLD")=""
        !            28:        I $O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"),0)) S V("WP")=0,^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))="wp"
        !            29:        Q
        !            30:        ;
        !            31: EN2    ;
        !            32: FIELD  Q:V=""
        !            33:        D SETXY
        !            34:        K F,N,P,W
        !            35:        S V=$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,1)_U_$S(DIFG("PARM")["N":DIFG2(DILL,"FLD"),1:"")_"="_X
        !            36:        D INCSET^DIFGGU
        !            37:        D:Y'="" PTRCHK
        !            38:        D:$D(V)>9 WP
        !            39:        K X,Y,V
        !            40:        Q
        !            41:        ;
        !            42: WP     NEW I
        !            43:        S DITAB=DITAB+2
        !            44:        S DIFG("WP")=""
        !            45:        F I=0:0 S I=$O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"),I)) Q:I=""  S V=""""_^(I)_"""" D INCSET^DIFGGU
        !            46:        S V="." D INCSET^DIFGGU
        !            47:        K DIFG("WP")
        !            48:        S DITAB=DITAB-2
        !            49:        Q
        !            50:        ;
        !            51: SETXY  S X=V
        !            52:        S Y=""
        !            53:        Q:$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2)'["P"
        !            54:        S F=+$P($P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2),"P",2),W=$P(^(0),U,4),N=$P(W,";",1),P=$P(W,";",2)
        !            55:        S Y=$P(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",N)"),U,P)
        !            56:        I $D(^UTILITY("DIFGLINK",$J,F,Y)) S X="@"_^UTILITY("DIFGLINK",$J,F,Y),Y="" Q
        !            57:        S ^UTILITY("DIFGLINK",$J)=$S($D(^UTILITY("DIFGLINK",$J))#2:^UTILITY("DIFGLINK",$J)+1,1:1)
        !            58:        S ^UTILITY("DIFGLINK",$J,F,Y)=^UTILITY("DIFGLINK",$J)
        !            59:        S Y="@"_^UTILITY("DIFGLINK",$J)
        !            60:        Q
        !            61:        ;
        !            62: PTRCHK Q:$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2)'["P"
        !            63:        S DITAB=DITAB+2
        !            64:        S DILL=DILL+1
        !            65:        D POINTER
        !            66:        S DITAB=DITAB-2
        !            67:        K DIFG(DILL)
        !            68:        S DILL=DILL-1
        !            69:        Q
        !            70:        ;
        !            71: POINTER        S DIFG(DILL,"FILE")=+$P($P(^DD(DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD"),0),U,2),"P",2),X=$P(^(0),U,4) S:$P(X,";")'=+X X=""""_$P(X,";")_""";"_$P(X,";",2)
        !            72:        S DIFG(DILL,"FE")=$P(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_$P(X,";",1)_")"),U,$P(X,";",2))
        !            73:        I '$D(^DIC(DIFG(DILL,"FILE"),0)) D KILLLL^DIFGGU Q
        !            74:        S DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL")
        !            75:        I '$D(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)")) D KILLLL^DIFGGU Q
        !            76:        S DIFG(DILL,"FNAME")=$P(^DIC(DIFG(DILL,"FILE"),0),U,1)
        !            77:        I $D(Y),Y'="" S Z=Y,Y=""
        !            78:        I $D(DIFGENV("LAYGO",DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD")))!($P(^DD(DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD"),0),U,2)'["'") S DIFG(DILL,"NOKEY")=""
        !            79:        D ^DIFGGSB
        !            80:        Q