| 1 | DIA ;SFISC/GFT-SELECT FIELDS TO EDIT ;7/10/97 11:37
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;12999;7752413;3179;
|
|---|
| 5 | ;
|
|---|
| 6 | D DICS
|
|---|
| 7 | 1 D F W !?F*3,"EDIT WHICH "_X I $S(DB:DIAT="",1:1) R ": ALL// ",X:DTIME S:'$T X=U,DTOUT=1 G ALL^DIA1:X=""!(X="ALL"),TEMP^DIA1:X?1"[".E&'F,L
|
|---|
| 8 | ED G NDB:DIAT=""
|
|---|
| 9 | GDB S Y=$P(DIAT,";",DB) I "Q"[Y G NDB:Y="" D DB G GDB
|
|---|
| 10 | I Y?.NP,$P(Y,":",2),Y'["/" S Y=+Y_"-"_$P(Y,":",2)
|
|---|
| 11 | I $D(DI(DB)),$D(DI(DB,F,DI,DIAO)) S Y=DI(DB,F,DI,DIAO)
|
|---|
| 12 | W ": "_Y D RW
|
|---|
| 13 | I X="" S X=Y I X="ALL" G ALL^DIA1
|
|---|
| 14 | L S DSC=X?1"^".E I DSC S X=$E(X,2,999) I U[X K DR Q
|
|---|
| 15 | I $A(X)=64 G X:X'?1P.N,P:$L(X)>1,X:'DB S DB=DB+1 G 2
|
|---|
| 16 | K DIC,DIAB D DICS S DV="",J=$P(X,"-",2) I +J=J,$P(X,"-",1)=+X,J>X S D(F)=J K DA D RANGE^DIA1 K D S Y=DA G X:Y="" D DB G 2
|
|---|
| 17 | DIC ;
|
|---|
| 18 | S DIC(0)="EZI",DIC="^DD(DI,",Y=-1 G X^DIA3:X[";" S DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")" D ^DIC Q:$D(DTOUT)
|
|---|
| 19 | I Y>0 D SET S Y=$P(Y(0),U,2) G 2:'Y S L=L+1,(DI,J(L))=+Y,I(L)=""""_$P($P(Y(0),U,4),";",1)_"""" G DOWN
|
|---|
| 20 | I $E(X)="]" S DRS=9,X=$E(X,2,999) G DIC:X]"",2
|
|---|
| 21 | G DIA^DIQQQ:X?."?" I $D(^DD(DI,"GR")) K Y S Y=-1 D:$L(X)<31
|
|---|
| 22 | . N I,DIGRP,DTOUT,DUOUT,DIRUT,DIROUT,DIYN S DIGRP=X,DIYN=0
|
|---|
| 23 | . D:$D(^DD(DI,"GR",DIGRP)) Q:DIYN F S DIGRP=$O(^DD(DI,"GR",DIGRP)) Q:$E(DIGRP,1,$L(X))'=X D Q:DIYN
|
|---|
| 24 | .. N X,I
|
|---|
| 25 | .. F I=0:0 S I=$O(^DD(DI,"GR",DIGRP,I)) Q:'I I $G(^DD(DI,I,0))]"" S I(I)=I_U_$P(^(0),U)
|
|---|
| 26 | .. Q:'$O(I(0))
|
|---|
| 27 | .. W !!,"Fields in Group: ",DIGRP F I=0:0 S I=$O(I(I)) Q:'I W !,?2,I,?10,$P(I(I),U,2)
|
|---|
| 28 | .. D Q:DIYN'=1
|
|---|
| 29 | ... N X,Y S DIR(0)="Y",DIR("A")="Edit this GROUP of fields",DIR("B")="YES" D ^DIR S DIYN=$S(Y=1:1,$G(DIRUT):2,1:0) Q
|
|---|
| 30 | .. M Y=I S Y=0 Q
|
|---|
| 31 | . Q
|
|---|
| 32 | K DIYN G X^DIA3
|
|---|
| 33 | ;
|
|---|
| 34 | F S X=$P(^DD(DI,0),U,1) I F,X="FIELD" S X=$O(^(0,"NM",0))_" "_X
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | X ;
|
|---|
| 38 | W $C(7),"??" D DICS
|
|---|
| 39 | 2 ;
|
|---|
| 40 | G 1:'$D(DR(F+1,DI)) D F W !?F*3,"THEN EDIT "_X G ED:DB
|
|---|
| 41 | R R ": ",X:DTIME E W $C(7) S X=U,DTOUT=1
|
|---|
| 42 | I X]"" G L
|
|---|
| 43 | UP ;
|
|---|
| 44 | G ^DIA1:'F K I(L),J(L) S L=L-1 I '$D(J(L)) F L=L-99:1 Q:'$D(J(L+1))
|
|---|
| 45 | I DB S DB=DB(F),DIAO=DIAO(F),DIAT=$S(DIAO<0:"",DIAO:^DIE(DIAA,"DR",F,J(L),DIAO),$D(^DIE(DIAA,"DR",F,J(L))):^(J(L)),1:"")
|
|---|
| 46 | S DIAP=DIAP(F),DI=J(L),F=F-1 G 2
|
|---|
| 47 | ;
|
|---|
| 48 | NDB I DB,DIAO'<0 S DIAO=DIAO+1 I $D(^DIE(DIAA,"DR",F+1,DI,DIAO)) S DIAT=^(DIAO),DB=1 G GDB
|
|---|
| 49 | S DIAO=-1 G R
|
|---|
| 50 | ;
|
|---|
| 51 | EN ;
|
|---|
| 52 | D OS^DII:'$D(DISYS),DICS
|
|---|
| 53 | DOWN S F=F+1,DIAP(F)=DIAP,DIAP=0 I DB S DB(F)=DB,DB=1,DIAO(F)=DIAO,DIAO=0,DIAT=$S($D(^DIE(DIAA,"DR",F+1,DI)):^(DI),1:"")
|
|---|
| 54 | G 1:$P(^DD(DI,.01,0),U,2)'["W",1:L#100=0,UP
|
|---|
| 55 | DICS ;
|
|---|
| 56 | S DIC("S")="I Y>.001,$P(^(0),U,2)'[""C"""_$S(DUZ(0)="@":"",1:",$P(^(0),U,2)'[""K""")_" Q:'$D(^(9)) I ^(9)'=U"_$S(DUZ(0)'="@":" F DW=1:1:$L(^(9)) I DUZ(0)[$E(^(9),DW) Q",1:"") Q
|
|---|
| 57 | ;
|
|---|
| 58 | P ;
|
|---|
| 59 | S DRS=99,Y=X D DB G 2
|
|---|
| 60 | ;
|
|---|
| 61 | SET S Y=+Y_DV
|
|---|
| 62 | DB ;
|
|---|
| 63 | I DB,'DSC S DB=DB+1
|
|---|
| 64 | D ;
|
|---|
| 65 | I '$D(DR(F+1,DI)) S DR(F+1,DI)="",DIAP=0
|
|---|
| 66 | E I $L(DR(F+1,DI))+$L(Y)>230 F %=0:1 I '$D(DW(DI,%)) S DIAP=DIAP\1000+1*1000,DW(DI)=F+1,DW(DI,%)=DR(F+1,DI),DR(F+1,DI)="" Q
|
|---|
| 67 | S DR(F+1,DI)=DR(F+1,DI)_Y_";",DRS=DRS+1,DIAP=DIAP+1 I $D(DIAB) S ^UTILITY($J,DIAP#1000,F,DI,DIAP\1000)=DIAB K DIAB
|
|---|
| 68 | Q
|
|---|
| 69 | RW I $L(Y)>19 D RW^DIR2 Q
|
|---|
| 70 | W "// " R X:DTIME I '$T S X=U,DTOUT=1 W $C(7)
|
|---|
