| 1 | DICRW ;SFISC/XAK-SELECT A FILE ;8/11/06 05:51
|
|---|
| 2 | ;;22.0;VA FileMan;**149**;Mar 30, 1999;Build 2
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | R D DT S D="OUTPUT FROM",DIC(0)="QEI",DIA=$S($D(^DISV(DUZ,"^DIC(")):^("^DIC("),1:"")
|
|---|
| 5 | D R1,DIC K DIAC,DIFILE,DIC("S") Q:$D(DTOUT) G R:'$T,AU:+Y=1.1,A:+Y=.6
|
|---|
| 6 | R2 I DUZ(0)'="@" S DICS="I 1 Q:'$D(^(8)) F DW=1:1:$L(^(8)) I DUZ(0)[$E(^(8),DW) Q"
|
|---|
| 7 | K DIA Q
|
|---|
| 8 | ;
|
|---|
| 9 | AU S D="AUDIT FROM",DIC(0)="QEI" S:'$D(DIC("S")) DIC("S")="I Y>1.1"
|
|---|
| 10 | S:DIA ^DISV(DUZ,"^DIC(")=DIA D DIC Q:'$D(DIC) G AU:Y<0
|
|---|
| 11 | I '$D(DDA),'$D(^DIA(+Y,0))#2 W $C(7)," NO AUDIT ENTRIES" G AU
|
|---|
| 12 | S DIA=+Y,Y="1.1^"_$P(Y,U,2)_" AUDIT",DIC="^DIA(DIA,"
|
|---|
| 13 | Q
|
|---|
| 14 | A S:'$D(DIC("S")) DIC("S")="S DIFILE=Y,DIAC=""DD"" D ^DIAC I %",DDA=""
|
|---|
| 15 | D AU Q:'$D(DIC)
|
|---|
| 16 | S %=$P(^DIC(DIA,0),U),Y=DIA D SUB I DIA'>0!$D(DTOUT)!$D(DUOUT) K DIC Q
|
|---|
| 17 | I '$D(^DDA(DIA,0)) W !," No DD AUDIT entries!" K DIC Q
|
|---|
| 18 | S Y=".6^"_$P(Y,U,2)_"DD AUDIT",DIC="^DDA(DIA,"
|
|---|
| 19 | Q
|
|---|
| 20 | SUB I $D(DIT) S L=L+1,DFL(L)=$O(^DD(+Y,0,"NM","")),(DFF,DFF(L))=+Y,Y=-1
|
|---|
| 21 | S DIC="^DD("_Y_"," Q:$O(^DD(Y,"SB",0))'>0 Q:$D(DIT)
|
|---|
| 22 | S DIC(0)="AEQIZ",DIC("A")="Select "_%_" SUB-FILE: "
|
|---|
| 23 | S DIC("S")="I $P(^(0),U,2)" D ^DIC Q:Y<0!$D(DTOUT) S Y=+$P(Y(0),U,2)
|
|---|
| 24 | S DIA=Y,%=$P($P(^DD(DIA,0),U)," SUB-FIELD")
|
|---|
| 25 | I $D(DIT) S X=$P($P(Y(0),U,4),";",1),DSUB(L)=$S(X:X,1:""""_X_"""")_","
|
|---|
| 26 | G SUB
|
|---|
| 27 | R1 S DIC("S")="S DIFILE=+Y,DIAC=""RD"" D ^DIAC I %"
|
|---|
| 28 | Q
|
|---|
| 29 | DT ;
|
|---|
| 30 | I $D(IO)#2,$D(IO(0))#2,IO=IO(0),IO=""
|
|---|
| 31 | E W:'$G(DIQUIET) !
|
|---|
| 32 | DTNOLF ; DT entry point without doing a line feed.
|
|---|
| 33 | S:$D(DUZ)#2-1 DUZ=0 S:$D(DUZ(0))#2-1 DUZ(0)="" S X=DUZ(0)="@" D 1
|
|---|
| 34 | I '$D(DTIME) S DTIME=300
|
|---|
| 35 | I '$D(DILOCKTM) S DILOCKTM=+$G(^DD("DILOCKTM"),1) ;DI*146
|
|---|
| 36 | K %DT,DT S:$D(IO(0))[0 IO(0)=$I D NOW^%DTC S DT=X,U="^"
|
|---|
| 37 | K DIK,DIC,%I,DICS Q
|
|---|
| 38 | ;
|
|---|
| 39 | 0 S X=0
|
|---|
| 40 | 1 D:'$D(DISYS) OS^DII
|
|---|
| 41 | Q
|
|---|
| 42 | W D DT S D=$S('$D(DDS1):"INPUT TO",1:DDS1),DIC(0)=$E("L",$D(DLAYGO)>0)_"EQI"
|
|---|
| 43 | D W1,DIC Q:$T!($D(DTOUT)) G W:'$P(Y,U,3) K DIC Q
|
|---|
| 44 | W1 S DIC("S")="I Y>.19,Y-1,Y-1.1,Y-.6,Y-.403,Y-.404,Y-.31 S DIFILE=+Y,DIAC=""WR"" D ^DIAC I %"
|
|---|
| 45 | Q
|
|---|
| 46 | DIC W ! S U="^",D=D_" WHAT FILE: ",DIC="^DIC("
|
|---|
| 47 | I DUZ(0)'="@",DIC(0)'["L",$S($D(^VA(200,"AFOF")):1,1:$D(^DIC(3,"AFOF"))) S DIC=$S($D(^VA(200,"AFOF")):"^VA(200,",1:DIC_"3,")_"DUZ,""FOF"","
|
|---|
| 48 | I $D(^DISV(DUZ,DIC)) S Y=^(DIC) I $D(@(DIC_Y_",0)")) X:$D(DIC("S")) DIC("S") I S Y=Y_U_$P(^DIC(Y,0),U),D=D_$P(Y,U,2)_"// "
|
|---|
| 49 | W D S %=$T R X:DTIME E W $C(7) S X=U,DTOUT=1,Y=-1 K DIC Q
|
|---|
| 50 | I '$D(@(DIC_"0)")) W " There are no selectable files." K DIC S Y=-1 Q
|
|---|
| 51 | S:DIC["FOF" DIC(0)=DIC(0)_"O" I X="",% G WW
|
|---|
| 52 | S DIC("W")=$P($T(WW1),";",3) D ^DIC I $D(DTOUT) K DIC Q
|
|---|
| 53 | GOT I $D(^DIC(+Y,0,"GL")) K DIC S DIC=^("GL") Q
|
|---|
| 54 | I U[X K DIC
|
|---|
| 55 | Q
|
|---|
| 56 | WW S A9=$P($T(WW1),";",3) X A9
|
|---|
| 57 | K A9
|
|---|
| 58 | G GOT
|
|---|
| 59 | ;
|
|---|
| 60 | D D DT S D="MODIFY",DIC(0)="LQEI",DIC("S")="I Y'<2 S DIFILE=+Y,DIAC=""DD"" D ^DIAC I %"
|
|---|
| 61 | D DIC S:DUZ(0)'="@" DICS="I 1 Q:'$D(^(9)) Q:^(9)=U F DW=1:1:$L(^(9)) I DUZ(0)[$E(^(9),DW) Q"
|
|---|
| 62 | Q:$T!($D(DTOUT)) G D:'$P(Y,U,3) K DIC
|
|---|
| 63 | Q
|
|---|
| 64 | DIAR ;
|
|---|
| 65 | D DT S D=$S($D(DIAX):"EXTRACT",1:"ARCHIVE")_" FROM",DIC(0)="QEI" D R1 S DIC("S")="I Y'<2 "_DIC("S")
|
|---|
| 66 | D DIC G R2:$D(DTOUT)!(X="^")!(X="")!(Y>0&($P($G(^DD(+Y,0,"DI")),U)'["Y"))
|
|---|
| 67 | W:$P($G(^DD(+Y,0,"DI")),U)["Y" !,$C(7),"SORRY, THIS IS ALREADY AN ARCHIVE FILE!"
|
|---|
| 68 | G DIAR
|
|---|
| 69 | Q
|
|---|
| 70 | T ; COMP/MERGE
|
|---|
| 71 | D DT S D="COMPARE ENTRIES IN",DIC=1,DIC(0)="QEI" D W1,DIC Q:$T!($D(DTOUT)) G T
|
|---|
| 72 | ;
|
|---|
| 73 | WW1 ;;W:$X>53 !?9 I Y-1.1,Y-.6,$D(^DIC(Y,0,"GL")),^("GL")'["[",$D(@(^("GL")_"0)")) S %=+$P(^(0),U,4) W ?40," ("_%_" entr"_$P("ies^y",U,%=1+1)_")"
|
|---|
