Return to DIP10.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

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

1.1     ! snw         1: DIP10  ;SFISC/TKW - PROCESS BY(0) INPUT VARIABLES ;12/5/94  14:10
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: EN     ;
        !             5:        N I,J,K,X,Y,DIR I $G(BY(0))="" D BLD^DIALOG(201,"BY(0)")
        !             6:        I $E(BY(0))'="[" D  I Y=-1 D BLD^DIALOG(201,"BY(0)")
        !             7:        . N %,X S X=BY(0),Y="" I X'["(" S:X[")"!(X[",") Y=-1 Q:Y=-1  S X=X_"("
        !             8:        . S:$E(X)'=U X=U_X
        !             9:        . S %=$E(X,$L(X)) S:%=")" $E(X,$L(X))=",",%="," I ",("'[% S X=X_","
        !            10:        . I $O(@(X_""""")"))="" S Y=-1 Q
        !            11:        . S BY(0)=X Q
        !            12:        I $E(BY(0))="[" D  I Y'<0 S BY(0)="^DIBT("_+Y_",1,",L(0)=1
        !            13:        .N DIC,DIBTFILE,DJ,DCC,DI,DNP,L S DIBTFILE=S N S
        !            14:        .S X=$P($E(BY(0),2,99),"]"),DIC="^DIBT(",DIC(0)="Q",DIC("S")="I '$P(^(0),U,8),$P(^(0),U,4)=DIBTFILE,$P(^(0),U,5)=DUZ!'$P(^(0),U,5),$O(^(1,0))"
        !            15:        .D ^DIC
        !            16:        .I Y<0 S I(1)=BY(0) D BLD^DIALOG(1500,.I)
        !            17:        .Q
        !            18:        I '$G(L(0)) D BLD^DIALOG(201,"L(0)")
        !            19:        S I=BY(0),X="" D  K I,X I '$D(L(0)) D BLD^DIALOG(201,"L(0)")
        !            20:        . N J F J=1:1:L(0) S X=$O(@(I_""""")")) S:X]"" X=$S(+$P(X,"E")'=X:$$QUOTE^DILIBF(X),1:X),I=I_X_"," I X="" K L(0) Q
        !            21:        . Q
        !            22:        G:$D(DIERR) EX
        !            23:        S DPP(0)=L(0)-1 K DPP(0,"TXT"),DISTXT
        !            24:        S J=8004 I BY(0)?1"^DIBT("1.N1",1," S J=+$P(BY(0),"^DIBT(",2) D ENT(0,J) S J=8003
        !            25:        I '$D(DISTXT) S I(1)=$S($E(BY(0),$L(BY(0)))=",":$E(BY(0),1,($L(BY(0))-1))_")",1:BY(0)) D BLD^DIALOG(J,.I,"","DIR") S DPP(0,"TXT")=DIR
        !            26:        F I=1:1:L(0)-1 S DPP(I)=S_"^^SORT FIELD "_I_"^""@^^^^^^4",DPP(I,"SER")="999^999",J="",$P(J,"D",L(0)-I+1)="",(DPP(I,"GET"),DPP(I,"CM"))="S DISX("_I_")="_J_"D0"
        !            27:        S DPP(0,"IX")=$E(U,$E(BY(0))'=U)_BY(0)_DCC_U_$S($D(L(0)):L(0),1:1)
        !            28:        F I=0:0 S I=$O(FR(0,I)) Q:'I  I $D(DPP(I)) S (Y,K)=FR(0,I) D:Y]"" FRV^DIP1 S DPP(I,"F")=Y_U_K S:I=1 DPP(0,"F")=Y_U_K
        !            29:        F I=0:0 S I=$O(TO(0,I)) Q:'I  I $D(DPP(I)) S DPP(I,"T")=TO(0,I)_U_TO(0,I)
        !            30:        F I=0:0 S I=$O(DISPAR(0,I)) Q:'I  D
        !            31:        .S X="""",J=$P(DISPAR(0,I),U) F K="!","#","+","@" I J[K S X=X_K
        !            32:        .I X'["@",$P(DISPAR(0,I),U,2)'[";""" S X=X_"@"
        !            33:        .S $P(DPP(I),U,4)=X S $P(DPP(I),U,5)=$P(DISPAR(0,I),U,2)
        !            34:        .I $G(DISPAR(0,I,"OUT"))]"" S DPP(I,"OUT")=DISPAR(0,I,"OUT")
        !            35:        .Q
        !            36:        I $D(FR)#2!($D(TO)#2) S J="",$P(J,",",L(0))="" S:$D(FR)#2 FR=J_FR S:$D(TO)#2 TO=J_TO G ENX
        !            37:        S J=$O(FR(8),-1) I J F J=J:-1:0 I $D(FR(J))#2 S FR(J+DPP(0))=FR(J) K FR(J)
        !            38:        S J=$O(TO(8),-1) I J F J=J:-1:0 I $D(TO(J))#2 S TO(J+DPP(0))=TO(J) K TO(J)
        !            39: ENX    S DJ=L(0) K DISPAR(0),L(0),FR(0),TO(0)
        !            40:        Q
        !            41:        ;
        !            42: ENT(I,J)       ;MOVE TEXT OF SEARCH AND GET CODE FROM SEARCH TEMPLATE TO DPP ARRAY
        !            43:        ;I=Entry no.in DPP array, J=record number for search template
        !            44:        Q:$G(I)=""  Q:'$G(J)  N DIR,%X,%Y
        !            45:        D BLD^DIALOG(8003,$P($G(^DIBT(J,0)),U),"","DIR") D:$O(^DIBT(J,"O",0))  S DISTXT(99,0)=DIR
        !            46:        . S %X="^DIBT("_J_",""O"",",%Y="DISTXT(" D %XY^%RCR
        !            47:        . S DIR="("_DIR_")" Q
        !            48:        S:I DPP(I,"GET")="S DISX("_I_")=D0"
        !            49:        Q
        !            50:        ;
        !            51: EX     K BY(0),L(0) Q:$G(DIQUIET)
        !            52:        D MSG^DIALOG("W") Q
        !            53:        ;DIALOG #201    'The input variable...is missing or invalid.'
        !            54:        ;       #1500   'Search template...in BY(0) variable cannot be found...'
        !            55:        ;       #8003   'Records from list on...search template.
        !            56:        ;       #8004   'Sort using...'