Return to DIFROM.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

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

1.1     ! snw         1: DIFROM ;SFISC/XAK-GENERATE INITS ;02:57 PM  7 Sep 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        D Q
        !             5:        S X=$S('$D(^DD("VERSION"))#2:0,1:^("VERSION")),Y=$P($T(DIFROM+1),";",3) G:X'=Y ERV K X,Y
        !             6:        I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !,"PROGRAMMER ACCESS REQUIRED",! Q
        !             7:        D WARN
        !             8:        S DIR("A")="Enter the Name of the Package (2-4 characters)"
        !             9:        S DIR(0)="FO^2:4:0^I X'?1U1.NU K X"
        !            10:        S DIR("?")="^D R^DIFROMH",DIR("??")=DIR("?")
        !            11:        D ^DIR G Q:$D(DIRUT) K DIR
        !            12:        S DIC="^DIC(9.4,",DIC(0)="EZ",D="C" D IX^DIC K D,DIC S DPK=+Y,DPK(0)=$S($D(Y(0)):Y(0),1:"")
        !            13: R      W !!,"I am going to create a routine called '",X,"INIT'."
        !            14:        S DTL=X,X=X_"INIT" D OS^DII
        !            15:        I $D(^DD("OS",DISYS,18)) X ^(18) I  W $C(7),!,"but '"_X_"' is ALREADY ON FILE!" S Q=1
        !            16:        K DIR S DIR("A")="Is that OK",DIR(0)="Y",DIR("??")="^D R1^DIFROMH"
        !            17:        D ^DIR G Q:$D(DIRUT)!'Y
        !            18:        S DIR("A")="Would you like to include Data Dictionaries",DIR("B")="YES"
        !            19:        S DIR("??")="^D R3^DIFROMH" D ^DIR G Q:$D(DIRUT) I 'Y S F(-1)=0 G DD
        !            20:        G L:DPK<0 S DIR("A")="Would you like to see the package definition"
        !            21:        S DIR("??")="^D CUR^DIFROMH1",DIR("B")="NO" D ^DIR G Q:$D(DIRUT)
        !            22:        I Y D L^DIFROMH1
        !            23:        S DIR("A")="Do you want to accept the current definition"
        !            24:        S DIR(0)="Y",DIR("??")="^D PKG^DIFROMH1" D ^DIR G Q:$D(DIRUT) S DIH=Y
        !            25:        F DA=0:0 S DA=$O(^DIC(9.4,DPK,4,DA)) G:'$D(^(+DA,0)) DD:$D(F),L S Y=+^(0) I $D(^DIC(Y,0))#2 S F(Y)=$P(^(0),U) W !!,F(Y) D SF G Q:%<0
        !            26: L      W !!,"THEN PLEASE LIST THE FILES THAT YOU WISH TO TRANSPORT:" S DIH=0,DPK=-1
        !            27:        F F=1:1 G Q:$D(DTOUT) K DIC S DIC("S")="I Y>1.9999&'$D(F(+Y))",DIC(0)="AIQEZ",DIC="^DIC(" D ^DIC G:Y<0 Q:X[U,DD S F(+Y)=$P(Y,U,2) D F
        !            28: DD     W ! F Y=1,2,3,4 S D=$P("DIE^DIPT^DIBT^DIST",U,Y),DIC=$P("INPUT^PRINT^SORT^FORM(S):",U,Y)_$S(Y<4:" TEMPLATE(S):",1:"") F %=0:0 S %=$O(^DIC(9.4,DPK,D,%)) Q:'$D(^(+%,0))  S DH=$P(^(0),U),X=$P(^(0),U,2) D T
        !            29:        S DN=DTL_$E("INI",1,5-$L(DTL))
        !            30:        K ^UTILITY(U,$J),DR S DRN=0,F=0,Q=DPK G Q:$D(F)+$D(Q)=2
        !            31:        D VER^DIFROM12 G Q:$D(DIRUT)
        !            32: S      G ^DIFROM0
        !            33:        ;
        !            34: T      W !,DIC,?24,DH
        !            35:        I Y'=4 F F=0:0 S @("F=$O(^"_D_"(""B"",DH,F))"),DIC="" Q:'F  I @("$D(^"_D_"(F,0))"),$P(^(0),U,4)=X!'X S Q(D,F)="",DIFC=1 G TQ
        !            36:        I Y=4 F F=0:0 S F=$O(^DIST(.403,"B",DH,F)),DIC="" Q:'F  I $D(^DIST(.403,F,0)),$P(^(0),U,8)=X S Q(D,F)="",DIFC=1 G TQ
        !            37:        W $C(7)," **NOT FOUND** "
        !            38: TQ     Q
        !            39:        ;
        !            40: SF     G F:$O(^DIC(9.4,DPK,4,DA,1,0))'>0
        !            41:        F %=0:0 S %=$O(^DIC(9.4,DPK,4,DA,1,%)) Q:%'>0  I $D(^(%,0)) S E=$P(^(0),U),D=$O(^DD(+Y,"B",E,0)) D:D="" ERF I $D(^DD(+Y,D,0)) S F(+Y,+Y,D)="",%C=+$P(^(0),U,2) I %C W "  (",E,")" S F(+Y,%C)=0
        !            42:        S F(+Y,+Y)=1,E=+Y S:(+Y'=200)!(DTL="XU") F(+Y,+Y,.01)=0 G E
        !            43: F      S F(+Y,+Y)=0,%=1,E=0 K %A
        !            44: E      F E=E:0 S E=$O(F(+Y,E)) Q:E'>0  F D=0:0 S D=$O(^DD(E,"SB",D)) Q:D'>0  I Y-E!'$D(%A)!$D(%A(D)) S F(+Y,D)="" S:$D(%A) %A(D)=0
        !            45:        S F(+Y,0)=^DIC(+Y,0,"GL"),D=$P(@(F(+Y,0)_"0)"),U,4),DPK(1)=+Y S:D<2 D=""
        !            46:        S DA(1)=DPK,DR="222.1;222.2;223;222.4;222.7;S:""n""[X Y=0;222.8;222.9;"
        !            47:        S DIE=$S(DPK>0:"^DIC(9.4,",1:"^UTILITY($J,")_DA(1)_",4,"
        !            48:        I DPK<0 S ^UTILITY($J,-1,4,0)="^9.44",^(+Y,0)=+Y,DA=+Y
        !            49:        I 'DIH W ! S DIE("W")="W !?2,$P(DQ(DQ),U),?32,"": """ D ^DIE I $D(Y) S %=-1
        !            50:        S F(DPK(1),-222)=$S($D(@(DIE_"DA,222)")):^(222),1:"y"),F(DPK(1),-223)=$S($D(^(223)):^(223),1:"") K DIE,DR
        !            51:        Q
        !            52:        ;
        !            53: ERF    S D=-1 W $C(7),!,"  INVALID FIELD LABEL:  "_E,! Q
        !            54: ERV    W $C(7),!!,"Your FileMan Version number: "_X_"  does not match the version number",!,"on the DIFROM routine: "_Y_" !!",!!,"You must run ^DINIT before you can build an INIT!!",! K X,Y Q
        !            55: Q      G Q^DIFROM11
        !            56: WARN   N I F I=1:1 Q:$T(WARN+I)=""  W !,$P($T(WARN+I),";;",2)
        !            57:        ;;                    * * Please Note * *
        !            58:        ;;
        !            59:        ;;     DIFROM gererates routines in the following format:
        !            60:        ;;
        !            61:        ;;     nmspInxx
        !            62:        ;;     ^^^^^^^^
        !            63:        ;;     ||||||||
        !            64:        ;;     |||||| \\- xx is any combination of numbers and
        !            65:        ;;     ||||||     upper case alpha characters.
        !            66:        ;;     ||||||
        !            67:        ;;     ||||| \--- n is a number 0 - 9 and uppercase letter N.
        !            68:        ;;     |||||
        !            69:        ;;     |||| \---- I is always uppercase letter I.
        !            70:        ;;     ||||
        !            71:        ;;      \\\\----- 2 to 4 characters of package namespace.
        !            72:        ;;
        !            73:        ;;     Any routines that support the init process should not
        !            74:        ;;     be in this format.
        !            75:        ;;