Return to DIP2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIP2.m, revision 1.1

1.1     ! snw         1: DIP2   ;SFISC/GFT-PRINT FLDS OR TEMPLATES ;2/10/94  09:48
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        K ^UTILITY("DIP2",$J),DG,K,DISH,DIL,DXS,A,P,I,J S I(0)=DI,(DE,DINS,DV,DNP)="",(DXS,DL,R)=1,(DIPT,DJ,DCL,DIL)=0,DK=+$P(@(DI_"0)"),U,2),J(0)=DK
        !             5: EN     ;
        !             6:        ;I $D(DIAR),'$D(DIARP(DIARF)) G DIP2^DIARA:DIAR=1 D DIP2^DIARA
        !             7: F      S (P,S)=""
        !             8: 1      ;G B:DC,B:DE'="",B:'$D(FLDS)
        !             9:        ;S DC=0,(X,DU)=FLDS
        !            10:        ;G ^DIP21
        !            11: B      S DU=$P(^DD(DK,0),U) I DL>1 S:DU="FIELD" DU=$O(^(0,"NM",0))_" "_DU I $O(^($O(^DD(DK,0))))'>0,$P(^(.01,0),U,2)["W" S:'DINS&DC DC=DC-2 S Y=.01 D P G N
        !            12:        K DIC,Y K:$D(DALL)<9 DALL I ('L!($G(DDXP)=4)),$D(FLDS) S X=$P(FLDS,C,R),R=R+1 G LIT
        !            13:        I DC D ^DIP22:'$D(DC(DC))
        !            14: 2      W !?DL+DL-2,$S(DE]""!($D(DJ)>9):"THEN",1:"FIRST")_$S($G(DDXP)=2:" EXPORT ",1:" PRINT ")_DU_": "
        !            15:        I DC W DC(DC) D RW G Q^DIP:X=U!($D(DTOUT)) S DINS=X?1"^"1E.E,X=$S(DINS:$E(X,2,999),X="":DC(DC),1:X) S:DC(DC)=""&$L(X) DINS=1 G XPCK
        !            16:        I $D(DIRPIPE) X DIRPIPE G LIT
        !            17:        R X:DTIME S:'$T X=U G Q^DIP:X=U
        !            18:        I X="ALL",DE="",$D(DJ)<2 D  G:$D(DIRUT) Q^DIP D:Y&($G(DDXP)=2) VALALL^DDXP2 G N:Y,F:'$D(X) W !?10,X
        !            19:        . S DIR(0)="YA",DIR("A")="  Do you mean ALL the fields in the file? ",DIR("B")="NO",DIR("?")="Choose YES for every field in the file; NO for a field starting with 'ALL'",%XX=X
        !            20:        . D ^DIR S X=%XX K DIR,%XX S:$D(DIRUT) X=U Q
        !            21: XPCK   I $G(DDXP)=2 D VAL1^DDXP2 G:'$D(X) F
        !            22: LIT    I $E(X)="""",$L(X,"""")#2 F A9=3:2:$L(X,Q) Q:$P(X,Q,A9)]""&($E($P(X,Q,A9)'=$C(95)))
        !            23:        I  I $P($P(X,Q,A9),";")="" K A9 S S=X G S:DINS,S:'$D(DIAR),S:DIAR'=4,S:'$D(DC(DC)),S:DC=0,Z^DIP22
        !            24:        S DIC="^DD(DK,",DIC(0)=$E("ZE",1,'$D(FLDS)!''L+1)_$E("O",1,DC>0),DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":""  (word-processing)"",1:""  (multiple)"")" S:$D(DICS) DIC("S")=DICS
        !            25: DIC    G DIC^DIP22
        !            26: RTN    I DC,X="@" D DC G F
        !            27:        G DIP2^DIQQ:X?."?",Q^DIP:X=U I $P("NUMBER",X,1)="" W $P("NUMBER",X,2) S S=0_S G S
        !            28:        S DIC(0)="EYZ",D="GR" I $D(^DD(DK,D)) D IX^DIC G GF:Y>0 I 'Y F Y=0:0 S Y=$O(Y(Y)) G F:Y="" S X=^DD(DK,Y,0) D Y
        !            29:        G HARD^DIP22
        !            30:        ;
        !            31: GF     I $G(DDXP)=2 D VAL2^DDXP2 G:'$D(Y(0)) F
        !            32:        I $P(Y(0),U,2) D D,DC:DC S X=$P($P(Y(0),U,4),";",1),I(DIL)=$S(+X=X:X,1:Q_X_Q),J(DIL)=DK G 1
        !            33:        I +Y=.001 S Y=0
        !            34:        S S=+Y_S I P]"",$D(DCL(DK_U_+Y)) G QQ^DIP22
        !            35: S      I $G(DDXP)=2 D VAL3^DDXP2 G:'$D(S) F
        !            36:        D DJ G F
        !            37:        ;
        !            38: D      S DIL(DL)=DIL,DV(DL)=DV,DL(DL)=DK,DK=+$P(^DD(DK,+Y,0),U,2),DL=DL+1,DIL=DIL+1,DV=DV_+Y_C,Y=0 Q
        !            39:        ;
        !            40: U      S DL=DL-1,DV=DV(DL),DK=DL(DL),DIL=DIL(DL) F %=DIL:0 S %=$O(I(%)) Q:%=""  K I(%),J(%)
        !            41:        Q
        !            42:        ;
        !            43: DC     I 'DINS K:DC>1 DC(DC) S DC=DC+1
        !            44:        Q
        !            45:        ;
        !            46: Y      S S=Y_S
        !            47: DJ     I $L(DE)+$L(S)>150 S DJ=DJ+1,^UTILITY("DIP2",$J,DJ)=DE,DE=""
        !            48:        S DE=DE_DV_S_$C(126),S="" D DC:DC
        !            49: P      Q:'$D(P)  I P="" K DNP Q
        !            50:        I P="*" S DCL=DCL+1
        !            51:        S DCL(DK_U_+Y)=$S($T:DCL_P,1:P) Q
        !            52:        ;
        !            53: N      S I=DL S:I=1 DALL=1
        !            54: NN     S Y=.001 I $D(^DD(DK,Y)) S Y=0 D Y S Y=.001
        !            55: A      S Y=$O(^DD(DK,Y)) I Y,$D(^(Y,8)),$D(DICS) X DICS E  G A
        !            56:        I Y'>0 G UP:I'<DL S Y=$P(DV,C,DL-1) D U G A
        !            57:        I $P(^(0),U,2) D D G NN
        !            58:        D Y G A
        !            59:        ;
        !            60: UP     K DIC I DL>1 D U,DC:DC G F
        !            61:        I DE="",'DJ,'$D(DHIT),'$D(DIS) G F
        !            62:        I $D(FLDS)>9 S X=$O(FLDS("")) I X]"" S FLDS=FLDS(X),R=1 K FLDS(X) G F
        !            63:        G ^DIP3
        !            64:        ;
        !            65: RW     I $L(DC(DC))>19 S Y=DC(DC) D RW^DIR2 Q
        !            66:        W "// " R X:DTIME S:'$T X=U,DTOUT=1 Q
        !            67:        ;
        !            68: ER     S (X,DU)="[CAPTIONED]" G ^DIP21