Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DID1.m

    r613 r623  
    1 DID1    ;SFISC/XAK,JLT-STD DD LIST ;9APR2007
    2         ;;22.0;VA FileMan;**7,76,105,152**;Mar 30, 1999;Build 10
    3         ;Per VHA Directive 2004-038, this routine should not be modified.
    4         S DJ(Z)=D0,DDL1=14,DDL2=32 G B
    5         ;
    6 L       S DJ(Z)=0
    7 A       S DJ(Z)=$O(^DD(F(Z),DJ(Z))) I DJ(Z)'>0 S:DJ(Z)="" DJ(Z)=-1 W !! S Z=Z-1 Q
    8 B       S N=^DD(F(Z),DJ(Z),0) K DDF I $D(DIGR),Z<2!(DJ(Z)-.01) X DIGR E  G ND
    9         D HD:$Y+6>IOSL Q:M=U  W !!,F(Z),",",DJ(Z)
    10         W ?(Z+Z+12),$P(N,U,1),?DDL2+4," "_$P(N,U,4)
    11         S X=$P(N,U,2)
    12 WP      I X,$D(^DD(+X,.01,0)) S W=$P(^(0),U,2) I W["W" D
    13         .S X="WORD-PROCESSING #"_+X D  S X="(NOWRAP)" D:W["L"  S X="(IGNORE ""|"")" D:W["X"!(W["x")  S X="(UNEDITABLE)" D:W["I"  S X=""
    14         ..W:$L(X)+$X+5>IOM !?18 W "   ",X
    15         F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","K","VARIABLE POINTER","p" I X[$E(W) D VP^DIDX:$E(W)="V" S:W="K" W="MUMPS" S:W="p" W="POINTER" W ?40," "_W G ND:M=U
    16         I +X S W=" Multiple" S W=W_" #"_+X D W G ND:M=U
    17         I X["V" S I=0 F  S I=$O(^DD(F(Z),D0,"V",I)) Q:I'>0  S %Y=$P(^(I,0),U) I $D(^DIC(%Y,0)),$D(@(^(0,"GL")_"0)")) S ^UTILITY($J,"P",$E($P(^(0),U),1,30),0)=%Y,^(F(Z),DJ(Z))=0
    18         S:I="" I=-1 G MP:X'["P"!X S Y=$P(N,U,3) I Y]"",$D(@("^"_Y_"0)")) S %Y=+$P(X,"P",2),W=" TO "_$P(^(0),U,1)_" FILE (#"_%Y_")",^UTILITY($J,"P",$E($P(^(0),U,1),1,30),0)=%Y,^(F(Z),DJ(Z))=0 D W G ND:M=U,MP
    19         S W=" ** TO AN UNDEFINED FILE ** " W:($L(W)+$X)'<IOM ! D W G ND:M=U
    20 MP      I X'["V" D RT^DIDX G:M=U ND
    21 S       I X["S" D  G ND:M=U
    22         . N N1
    23         . S N1=$P(N,U,3) F %1=1:1 S Y=$P(N1,";",%1) Q:Y=""  W ! S W="'"_$P(Y,":",1)_"' FOR "_$P(Y,":",2)_"; " D W Q:M=U
    24         G RD:$D(DINM) I X["C" S W=$P(N,U,5,99) W !?DDL1,"MUMPS CODE: " D W G ND:M=U G RD
    25         I "Q"'[$P(N,U,5) W !?DDL1,"INPUT TRANSFORM:" S W=$P(N,U,5,99) D W G ND:M=U
    26         I $D(^DD(F(Z),DJ(Z),2))#2 W !?DDL1,"OUTPUT TRANSFORM:" S W=$S($D(^DD(F(Z),DJ(Z),2.1)):^(2.1),1:^(2)) D W G ND:M=U
    27 RD      D ^DID2:$O(^DD(F(Z),DJ(Z),2.99))]"" G ND:M=U I 'X S W="UNEDITABLE" W:X["I" ! D W:X["I" G N
    28         I $O(^DD(+X,0,"ID",""))]"" W !?DDL1,"IDENTIFIED BY:" S W="" F %=0:0 S %=$O(^DD(+X,0,"ID",%)) S:%>0 W=W_$P(^DD(+X,%,0),U)_"(#"_%_")"_$S($P(^(0),U,2)["R":"[R]",1:"")_", " I %'>0 S:W?.E1", " W=$E(W,1,$L(W)-2) D W G ND:M=U Q
    29         ;
    30         ;Print "WRITE" identifiers
    31         I '$D(DINM) S %=" " F  S %=$O(^DD(+X,0,"ID",%)) Q:%=""  D  Q:M=U
    32         . N DIDLN,DIDPG
    33         . S DIDLN(1)=$G(^DD(+X,0,"ID",%)) Q:DIDLN(1)?."^"
    34         . S DIDLN(0)=""""_%_""":    "
    35         . S DIDLN(0)=$J("",DDL2-DDL1-$L(DIDLN(0)))_DIDLN(0)
    36         . S DIDPG("H")="W """" D H^DIDH S:M=U PAGE(U)=1"
    37         . D WRPHI^DIKCP1(.DIDLN,IOM-1-DDL2,DDL1,DDL2-DDL1,1,.DIDPG)
    38         G:M=U ND
    39         ;
    40         I $D(^DD("KEY","B",+X)) D  G:M=U ND
    41         . N DIDPG
    42         . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
    43         . D PRINT^DIKKP(+X,"","L"_DDL1_"C"_(DDL2-DDL1),.DIDPG)
    44         I $D(^DD("IX","B",+X)) D  G:M=U ND
    45         . N DIDPG
    46         . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
    47         . D LIST^DIKCP(+X,"","L"_DDL1_"C"_(DDL2-DDL1),.DIDPG)
    48         S Z=Z+1,DDL1=DDL1+2,DDL2=DDL2+2,F(Z)=+X
    49         D L
    50 N       K DDN1 I X["X" S DDN1=1 W !,?DDL1,"NOTES:",?DDL2,"XXXX--CAN'T BE ALTERED EXCEPT BY PROGRAMMER" W ! G ND:M=U
    51         S W=0 I $O(^DD(F(Z),DJ(Z),5,W))'="",'$D(DDN1) W !?DDL1,"NOTES:"
    52 TR      S W=$O(^DD(F(Z),DJ(Z),5,W)) S:W="" W=-1 G IX:W'>0 S I=^(W,0),%=+I I '$D(^DD(%,$P(I,U,2),0))!$D(W(I)) K ^DD(F(Z),DJ(Z),5,W) G TR
    53         S W(I)=0 S WS=W D WR^DIDH1 W ! S W=WS K WS G TR
    54 IX      S F=0 F  G ND:M=U S F=$O(^DD(F(Z),DJ(Z),1,F)) Q:F'>0  W !?DDL1,"CROSS-REFERENCE:" D IX1
    55         S:F="" F=-1
    56         I $D(^DD("IX","F",F(Z),DJ(Z))) D  S:M=U DN=0
    57         . N DIDPG,DIDFLAG
    58         . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
    59         . S DIDFLAG="L"_DDL1_"C"_(DDL2-DDL1)_"T1"
    60         . D PRINT^DIKCP(F(Z),DJ(Z),$E("R",$G(DIDRANGE))_"FS"_DIDFLAG_$E("N",$D(DINM)#2),.DIDPG) Q:M=U
    61         . D:'$G(DIDRANGE) LIST^DIKCP(F(Z),DJ(Z),"RS"_DIDFLAG,.DIDPG)
    62 ND      S X="" G:M'=U A:Z>1 Q
    63 IX1     S W=^(F,0)_" " K DDF W ?DDL2,W,! G ND:M=U D TP:$P(W,U,3)["TRIG" I '$D(DINM) S X=0 F %=0:0 S X=$O(^DD(F(Z),DJ(Z),1,F,X)) Q:X=""  I X'="%D",X'="DT" S W=^(X) S:$L(W)<248 W=X_")= "_W K:X=3 DDF D W W ! G ND:M=U
    64         Q:'$D(^("%D"))
    65         ;
    66         N DIDI,DIDN,DIDZ,DIWF,DIWL,DIWR,X
    67         K ^UTILITY($J,"W")
    68         S DIWF="W",DIWL=DDL2+1,DIWR=IOM,DIDZ=Z
    69         S DIDN=$P($G(^DD(F(DIDZ),DJ(DIDZ),1,F,"%D",0)),U,3),DIDI=0
    70         F  S DIDI=$O(^DD(F(DIDZ),DJ(DIDZ),1,F,"%D",DIDI)) Q:'DIDI!(DIDN&(DIDI>DIDN))  S X=^(DIDI,0) D ^DIWP I $D(DN),'DN S M=U Q
    71         I M'=U D ^DIWW I $D(DN),'DN S M=U
    72         I M'=U W !
    73         E  K DIOEND
    74         S Z=DIDZ
    75         K ^UTILITY($J,"W")
    76         Q
    77         ;
    78 TP      S X=+$P(^(0),U,4) I F(Z)-X,$D(^DIC(X,0))#2 S ^UTILITY($J,"P",$E($P(^(0),U,1),1,30),0)=X,^(F(Z),DJ(Z))=6
    79         Q
    80 W       F K=0:0 W:$D(DDF) ! S:(($L(W)+DDL2)>IOM) DDL2=32 W ?DDL2 S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1) Q:%Y=""  S W=%Y,DDF=1
    81         K:'X DDF Q:$Y+6<IOSL
    82 HD      S DC=DC+1 D ^DIDH Q
     1DID1 ;SFISC/XAK,JLT-STD DD LIST ;1:53 PM  6 Mar 2002
     2 ;;22.0;VA FileMan;**7,76,105**;Mar 30, 1999
     3 ;Per VHA Directive 10-93-142, this routine should not be modified.
     4 S DJ(Z)=D0,DDL1=14,DDL2=32 G B
     5 ;
     6L S DJ(Z)=0
     7A S DJ(Z)=$O(^DD(F(Z),DJ(Z))) I DJ(Z)'>0 S:DJ(Z)="" DJ(Z)=-1 W !! S Z=Z-1 Q
     8B S N=^DD(F(Z),DJ(Z),0) K DDF I $D(DIGR),Z<2!(DJ(Z)-.01) X DIGR E  G ND
     9 D HD:$Y+6>IOSL Q:M=U  W !!,F(Z),",",DJ(Z)
     10 W ?(Z+Z+12),$P(N,U,1),?DDL2+4," "_$P(N,U,4)
     11 S X=$P(N,U,2) I X,$D(^DD(+X,.01,0)) S W=$P(^(0),U,2) I W["W" W "   WORD-PROCESSING #",+X W:W["L" " (NOWRAP)" S X=""
     12 F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","K","VARIABLE POINTER","p" I X[$E(W) D VP^DIDX:$E(W)="V" S:W="K" W="MUMPS" S:W="p" W="POINTER" W ?40," "_W G ND:M=U
     13 I +X S W=" Multiple" S W=W_" #"_+X D W G ND:M=U
     14 I X["V" S I=0 F  S I=$O(^DD(F(Z),D0,"V",I)) Q:I'>0  S %Y=$P(^(I,0),U) I $D(^DIC(%Y,0)),$D(@(^(0,"GL")_"0)")) S ^UTILITY($J,"P",$E($P(^(0),U),1,30),0)=%Y,^(F(Z),DJ(Z))=0
     15 S:I="" I=-1 G MP:X'["P"!X S Y=$P(N,U,3) I Y]"",$D(@("^"_Y_"0)")) S %Y=+$P(X,"P",2),W=" TO "_$P(^(0),U,1)_" FILE (#"_%Y_")",^UTILITY($J,"P",$E($P(^(0),U,1),1,30),0)=%Y,^(F(Z),DJ(Z))=0 D W G ND:M=U,MP
     16 S W=" ** TO AN UNDEFINED FILE ** " W:($L(W)+$X)'<IOM ! D W G ND:M=U
     17MP I X'["V" D RT^DIDX G:M=U ND
     18S I X["S" D  G ND:M=U
     19 . N N1
     20 . S N1=$P(N,U,3) F %1=1:1 S Y=$P(N1,";",%1) Q:Y=""  W ! S W="'"_$P(Y,":",1)_"' FOR "_$P(Y,":",2)_"; " D W Q:M=U
     21 G RD:$D(DINM) I X["C" S W=$P(N,U,5,99) W !?DDL1,"MUMPS CODE: " D W G ND:M=U G RD
     22 I "Q"'[$P(N,U,5) W !?DDL1,"INPUT TRANSFORM:" S W=$P(N,U,5,99) D W G ND:M=U
     23 I $D(^DD(F(Z),DJ(Z),2))#2 W !?DDL1,"OUTPUT TRANSFORM:" S W=$S($D(^DD(F(Z),DJ(Z),2.1)):^(2.1),1:^(2)) D W G ND:M=U
     24RD D ^DID2:$O(^DD(F(Z),DJ(Z),2.99))]"" G ND:M=U I 'X S W="UNEDITABLE" W:X["I" ! D W:X["I" G N
     25 I $O(^DD(+X,0,"ID",""))]"" W !?DDL1,"IDENTIFIED BY:" S W="" F %=0:0 S %=$O(^DD(+X,0,"ID",%)) S:%>0 W=W_$P(^DD(+X,%,0),U)_"(#"_%_")"_$S($P(^(0),U,2)["R":"[R]",1:"")_", " I %'>0 S:W?.E1", " W=$E(W,1,$L(W)-2) D W G ND:M=U Q
     26 ;
     27 ;Print "WRITE" identifiers
     28 I '$D(DINM) S %=" " F  S %=$O(^DD(+X,0,"ID",%)) Q:%=""  D  Q:M=U
     29 . N DIDLN,DIDPG
     30 . S DIDLN(1)=$G(^DD(+X,0,"ID",%)) Q:DIDLN(1)?."^"
     31 . S DIDLN(0)=""""_%_""":    "
     32 . S DIDLN(0)=$J("",DDL2-DDL1-$L(DIDLN(0)))_DIDLN(0)
     33 . S DIDPG("H")="W """" D H^DIDH S:M=U PAGE(U)=1"
     34 . D WRPHI^DIKCP1(.DIDLN,IOM-1-DDL2,DDL1,DDL2-DDL1,1,.DIDPG)
     35 G:M=U ND
     36 ;
     37 I $D(^DD("KEY","B",+X)) D  G:M=U ND
     38 . N DIDPG
     39 . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
     40 . D PRINT^DIKKP(+X,"","L"_DDL1_"C"_(DDL2-DDL1),.DIDPG)
     41 I $D(^DD("IX","B",+X)) D  G:M=U ND
     42 . N DIDPG
     43 . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
     44 . D LIST^DIKCP(+X,"","L"_DDL1_"C"_(DDL2-DDL1),.DIDPG)
     45 S Z=Z+1,DDL1=DDL1+2,DDL2=DDL2+2,F(Z)=+X
     46 D L
     47N K DDN1 I X["X" S DDN1=1 W !,?DDL1,"NOTES:",?DDL2,"XXXX--CAN'T BE ALTERED EXCEPT BY PROGRAMMER" W ! G ND:M=U
     48 S W=0 I $O(^DD(F(Z),DJ(Z),5,W))'="",'$D(DDN1) W !?DDL1,"NOTES:"
     49TR S W=$O(^DD(F(Z),DJ(Z),5,W)) S:W="" W=-1 G IX:W'>0 S I=^(W,0),%=+I I '$D(^DD(%,$P(I,U,2),0))!$D(W(I)) K ^DD(F(Z),DJ(Z),5,W) G TR
     50 S W(I)=0 S WS=W D WR^DIDH1 W ! S W=WS K WS G TR
     51IX S F=0 F  G ND:M=U S F=$O(^DD(F(Z),DJ(Z),1,F)) Q:F'>0  W !?DDL1,"CROSS-REFERENCE:" D IX1
     52 S:F="" F=-1
     53 I $D(^DD("IX","F",F(Z),DJ(Z))) D  S:M=U DN=0
     54 . N DIDPG,DIDFLAG
     55 . S DIDPG("H")="W """" S DC=DC+1 D ^DIDH1 S:M=U PAGE(U)=1"
     56 . S DIDFLAG="L"_DDL1_"C"_(DDL2-DDL1)_"T1"
     57 . D PRINT^DIKCP(F(Z),DJ(Z),$E("R",$G(DIDRANGE))_"FS"_DIDFLAG_$E("N",$D(DINM)#2),.DIDPG) Q:M=U
     58 . D:'$G(DIDRANGE) LIST^DIKCP(F(Z),DJ(Z),"RS"_DIDFLAG,.DIDPG)
     59ND S X="" G:M'=U A:Z>1 Q
     60IX1 S W=^(F,0)_" " K DDF W ?DDL2,W,! G ND:M=U D TP:$P(W,U,3)["TRIG" I '$D(DINM) S X=0 F %=0:0 S X=$O(^DD(F(Z),DJ(Z),1,F,X)) Q:X=""  I X'="%D",X'="DT" S W=^(X) S:$L(W)<248 W=X_")= "_W K:X=3 DDF D W W ! G ND:M=U
     61 Q:'$D(^("%D"))
     62 ;
     63 N DIDI,DIDN,DIDZ,DIWF,DIWL,DIWR,X
     64 K ^UTILITY($J,"W")
     65 S DIWF="W",DIWL=DDL2+1,DIWR=IOM,DIDZ=Z
     66 S DIDN=$P($G(^DD(F(DIDZ),DJ(DIDZ),1,F,"%D",0)),U,3),DIDI=0
     67 F  S DIDI=$O(^DD(F(DIDZ),DJ(DIDZ),1,F,"%D",DIDI)) Q:'DIDI!(DIDN&(DIDI>DIDN))  S X=^(DIDI,0) D ^DIWP I $D(DN),'DN S M=U Q
     68 I M'=U D ^DIWW I $D(DN),'DN S M=U
     69 I M'=U W !
     70 E  K DIOEND
     71 S Z=DIDZ
     72 K ^UTILITY($J,"W")
     73 Q
     74 ;
     75TP S X=+$P(^(0),U,4) I F(Z)-X,$D(^DIC(X,0))#2 S ^UTILITY($J,"P",$E($P(^(0),U,1),1,30),0)=X,^(F(Z),DJ(Z))=6
     76 Q
     77W F K=0:0 W:$D(DDF) ! S:(($L(W)+DDL2)>IOM) DDL2=32 W ?DDL2 S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1) Q:%Y=""  S W=%Y,DDF=1
     78 K:'X DDF Q:$Y+6<IOSL
     79HD S DC=DC+1 D ^DIDH Q
Note: See TracChangeset for help on using the changeset viewer.