DICATTA ;SFISC/YJK-DD AUDIT ;1/4/94 08:21
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
I S B1="0,.1,3,4,8,8.5,9,9.1,10,AUDIT,AX" Q
SV ;
D I F %=1:1 S A0=$P(B1,",",%) Q:A0="" I $D(^DD(A,+Y,A0)) S ^UTILITY("DDA",$J,A,+Y,A0)=^(A0)
K %,A0,B1 Q
;
AUDT ;
S B0=DDA(1) I DDA="E" D B G QQ
S A0="LABEL^.01" D ADD I DDA["D" S ^DDA(B0,%D,1)=$P(^UTILITY("DDA",$J,B0,DA,0),U,1)
E S ^DDA(B0,%D,2)=$P(^DD(B0,DA,0),U,1)
G QQ
;
B S A0="",A1=^UTILITY("DDA",$J,B0,DA,0),A2=^DD(B0,DA,0)
S A3=1,A5="LABEL^TYPE^TYPE",B3=".01^.25^.25"
F %=1:1:3 I $P(A1,U,%)'=$P(A2,U,%) S $P(A0,",",A3)=$P(A5,U,%),$P(A4,",",A3)=$P(B3,U,%),$P(B1,"^",A3)=$P(A1,U,%),$P(B2,"^",A3)=$P(A2,U,%),A3=A3+1
I $P(A1,U,5,99)'=$P(A2,U,5,99) S $P(A0,",",A3)="INPUT TRANSFORM",$P(B1,"^",A3)=$P(A1,U,5,99),$P(B2,"^",A3)=$P(A2,U,5,99),$P(A4,",",A3)=.5
I A0]"" S A0=A0_"^"_A4,A1=B1,A2=B2 D ADD,E
K B3,A1,A2,A3,A4,A5 D I
B1 F B2=2:1 S %=$P(B1,",",B2) Q:%="" S:$D(^UTILITY("DDA",$J,B0,DA,%)) A1=^(%) S:$D(^DD(B0,DA,%)) A2=^(%) I $D(A1)!$D(A2) S %=$S(%="AUDIT":1.1,%="AX":1.2,1:%),A0=$S($D(^DD(0,%,0)):$P(^(0),U,1),1:"")_"^"_% D P
Q
;
P I $D(A1),'$D(A2) S DDA="D" D ADD S ^(1)=A1 K A1 Q
I '$D(A1),$D(A2) S DDA="N" D ADD S ^(2)=A2 K A2 Q
I A1'=A2 S DDA="E" D ADD,E
K A1,A2 Q
;
ADD I '$D(^DDA(B0,0)) S %=$P(^DIC(J(0),0),U,1),^DDA(B0,0)=$S(B0=J(0):%,1:%_" ("_$P(^DD(B0,0),U,1)_")")_" DD AUDIT^.6I"
F B3=$P(^(0),U,3):1 I '$D(^(B3)) L +^DDA(B0,B3):0 Q:$T
S $P(^(0),U,3,4)=B3_U_($P(^(0),U,4)+1),^(B3,0)=DA L -^DDA(B0,B3)
S %T=$P($H,",",2),%T=%T#60/100+(%T#3600\60)/100+(%T\3600)/100,%T=DT_%T
S ^DDA(B0,"D",%T,B3)="",^DDA(B0,"E",DUZ,B3)="",^DDA(B0,"B",DA,B3)="",^DDA(B0,B3,0)=DA_U_DDA_U_%T_U_DUZ_U_A0_U_B0,%D=B3
K B3,%T,% Q
;
E S:A1]"" ^(1)=A1 S:A2]"" ^(2)=A2 Q
;
IT ;
S B0=DI,DDA="E" D ADD,E G QQ
;
IT1 ;
S B1=",3,4,12.1",B0=DI D B1 G QQ
;
XS ;
I $P(^DD(J(N),DA,1,DQ,0),U,3)["TRIG"!($P(^(0),U,3)["BULL") S DDA="TE" Q:'$D(^(3)) S ^UTILITY("DDA",$J,J(N),DA,3)=^(3) Q
S %=0 F B1=1:1 S %=$O(^DD(J(N),DA,1,DQ,%)) Q:+%'>0 S ^UTILITY("DDA",$J,J(N),DA,B1)=^(%)
K B1,% Q
;
XA ;
S B0=J(N),DA=DL,A0="CROSS REFERENCE^1"
I DDA["T" S DDA="E" D TR G QQ
S %=0 D CK G:'% QQ D ADD S B1=$S(DDA["D":1.1,1:2.1),A0="^DD(B0,DA,1,DQ," D XL
QQ S DDA="" K B0,%D,B1,B2,%,A0,A1,A2,^UTILITY("DDA",$J) Q
;
CK K A1,A2 F B1=1:1:3 S:$D(^DD(B0,DA,1,DQ,B1)) A1=^(B1) S:$D(^UTILITY("DDA",$J,B0,DA,B1)) A2=^(B1) I $D(A1)!$D(A2) D C Q:%
Q
;
C I ($D(A1)&'$D(A2))!('$D(A1)&$D(A2)) S %=1 Q
S:A1'=A2 %=1 Q
;
XL S %=0 F B2=1:1 S %=$O(@(A0_%_")")) Q:+%'>0 S ^DDA(B0,%D,B1,B2,0)=^(%)
S B2=B2-1,%=$S(B1=1.1:.601,1:.602),^DDA(B0,%D,B1,0)="^"_%_"^"_B2_"^"_B2_"^"_DT
I DDA["E",B1=2.1 S B1=1.1,A0="^UTILITY(""DDA"",$J,B0,DA," G XL
K %,B2 Q
;
TR ;
K A1,A2 S:$D(^DD(B0,DA,1,DQ,3)) A2=^(3) S:$D(^UTILITY("DDA",$J,B0,DA,3)) A1=^(3) Q:'$D(A1)&'$D(A2)
I $D(A1),$D(A2) Q:A1=A2 D ADD S ^DDA(B0,%D,1)=A1,^(2)=A2 Q
D ADD S:$D(A1) ^DDA(B0,%D,1)=A1 S:$D(A2) ^DDA(B0,%D,2)=A2 Q
;;
DICATTA ;SFISC/YJK-DD AUDIT ;1/4/94 08:21
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
I SET B1="0,.1,3,4,8,8.5,9,9.1,10,AUDIT,AX"
QUIT
SV ;
+1 DO I
FOR %=1:1
SET A0=$PIECE(B1,",",%)
IF A0=""
QUIT
IF $DATA(^DD(A,+Y,A0))
SET ^UTILITY("DDA",$JOB,A,+Y,A0)=^(A0)
+2 KILL %,A0,B1
QUIT
+3 ;
AUDT ;
+1 SET B0=DDA(1)
IF DDA="E"
DO B
GOTO QQ
+2 SET A0="LABEL^.01"
DO ADD
IF DDA["D"
SET ^DDA(B0,%D,1)=$PIECE(^UTILITY("DDA",$JOB,B0,DA,0),U,1)
+3 IF '$TEST
SET ^DDA(B0,%D,2)=$PIECE(^DD(B0,DA,0),U,1)
+4 GOTO QQ
+5 ;
B SET A0=""
SET A1=^UTILITY("DDA",$JOB,B0,DA,0)
SET A2=^DD(B0,DA,0)
+1 SET A3=1
SET A5="LABEL^TYPE^TYPE"
SET B3=".01^.25^.25"
+2 FOR %=1:1:3
IF $PIECE(A1,U,%)'=$PIECE(A2,U,%)
SET $PIECE(A0,",",A3)=$PIECE(A5,U,%)
SET $PIECE(A4,",",A3)=$PIECE(B3,U,%)
SET $PIECE(B1,"^",A3)=$PIECE(A1,U,%)
SET $PIECE(B2,"^",A3)=$PIECE(A2,U,%)
SET A3=A3+1
+3 IF $PIECE(A1,U,5,99)'=$PIECE(A2,U,5,99)
SET $PIECE(A0,",",A3)="INPUT TRANSFORM"
SET $PIECE(B1,"^",A3)=$PIECE(A1,U,5,99)
SET $PIECE(B2,"^",A3)=$PIECE(A2,U,5,99)
SET $PIECE(A4,",",A3)=.5
+4 IF A0]""
SET A0=A0_"^"_A4
SET A1=B1
SET A2=B2
DO ADD
DO E
+5 KILL B3,A1,A2,A3,A4,A5
DO I
B1 FOR B2=2:1
SET %=$PIECE(B1,",",B2)
IF %=""
QUIT
IF $DATA(^UTILITY("DDA",$JOB,B0,DA,%))
SET A1=^(%)
IF $DATA(^DD(B0,DA,%))
SET A2=^(%)
IF $DATA(A1)!$DATA(A2)
SET %=$SELECT(%="AUDIT":1.1,%="AX":1.2,1:%)
SET A0=$SELECT($DATA(^DD(0,%,0)):$PIECE(^(0),U,1),1:"")_"^"_%
DO P
+1 QUIT
+2 ;
P IF $DATA(A1)
IF '$DATA(A2)
SET DDA="D"
DO ADD
SET ^(1)=A1
KILL A1
QUIT
+1 IF '$DATA(A1)
IF $DATA(A2)
SET DDA="N"
DO ADD
SET ^(2)=A2
KILL A2
QUIT
+2 IF A1'=A2
SET DDA="E"
DO ADD
DO E
+3 KILL A1,A2
QUIT
+4 ;
ADD IF '$DATA(^DDA(B0,0))
SET %=$PIECE(^DIC(J(0),0),U,1)
SET ^DDA(B0,0)=$SELECT(B0=J(0):%,1:%_" ("_$PIECE(^DD(B0,0),U,1)_")")_" DD AUDIT^.6I"
+1 FOR B3=$PIECE(^(0),U,3):1
IF '$DATA(^(B3))
LOCK +^DDA(B0,B3):0
IF $TEST
QUIT
+2 SET $PIECE(^(0),U,3,4)=B3_U_($PIECE(^(0),U,4)+1)
SET ^(B3,0)=DA
LOCK -^DDA(B0,B3)
+3 SET %T=$PIECE($HOROLOG,",",2)
SET %T=%T#60/100+(%T#3600\60)/100+(%T\3600)/100
SET %T=DT_%T
+4 SET ^DDA(B0,"D",%T,B3)=""
SET ^DDA(B0,"E",DUZ,B3)=""
SET ^DDA(B0,"B",DA,B3)=""
SET ^DDA(B0,B3,0)=DA_U_DDA_U_%T_U_DUZ_U_A0_U_B0
SET %D=B3
+5 KILL B3,%T,%
QUIT
+6 ;
E IF A1]""
SET ^(1)=A1
IF A2]""
SET ^(2)=A2
QUIT
+1 ;
IT ;
+1 SET B0=DI
SET DDA="E"
DO ADD
DO E
GOTO QQ
+2 ;
IT1 ;
+1 SET B1=",3,4,12.1"
SET B0=DI
DO B1
GOTO QQ
+2 ;
XS ;
+1 IF $PIECE(^DD(J(N),DA,1,DQ,0),U,3)["TRIG"!($PIECE(^(0),U,3)["BULL")
SET DDA="TE"
IF '$DATA(^(3))
QUIT
SET ^UTILITY("DDA",$JOB,J(N),DA,3)=^(3)
QUIT
+2 SET %=0
FOR B1=1:1
SET %=$ORDER(^DD(J(N),DA,1,DQ,%))
IF +%'>0
QUIT
SET ^UTILITY("DDA",$JOB,J(N),DA,B1)=^(%)
+3 KILL B1,%
QUIT
+4 ;
XA ;
+1 SET B0=J(N)
SET DA=DL
SET A0="CROSS REFERENCE^1"
+2 IF DDA["T"
SET DDA="E"
DO TR
GOTO QQ
+3 SET %=0
DO CK
IF '%
GOTO QQ
DO ADD
SET B1=$SELECT(DDA["D":1.1,1:2.1)
SET A0="^DD(B0,DA,1,DQ,"
DO XL
QQ SET DDA=""
KILL B0,%D,B1,B2,%,A0,A1,A2,^UTILITY("DDA",$JOB)
QUIT
+1 ;
CK KILL A1,A2
FOR B1=1:1:3
IF $DATA(^DD(B0,DA,1,DQ,B1))
SET A1=^(B1)
IF $DATA(^UTILITY("DDA",$JOB,B0,DA,B1))
SET A2=^(B1)
IF $DATA(A1)!$DATA(A2)
DO C
IF %
QUIT
+1 QUIT
+2 ;
C IF ($DATA(A1)&'$DATA(A2))!('$DATA(A1)&$DATA(A2))
SET %=1
QUIT
+1 IF A1'=A2
SET %=1
QUIT
+2 ;
XL SET %=0
FOR B2=1:1
SET %=$ORDER(@(A0_%_")"))
IF +%'>0
QUIT
SET ^DDA(B0,%D,B1,B2,0)=^(%)
+1 SET B2=B2-1
SET %=$SELECT(B1=1.1:.601,1:.602)
SET ^DDA(B0,%D,B1,0)="^"_%_"^"_B2_"^"_B2_"^"_DT
+2 IF DDA["E"
IF B1=2.1
SET B1=1.1
SET A0="^UTILITY(""DDA"",$J,B0,DA,"
GOTO XL
+3 KILL %,B2
QUIT
+4 ;
TR ;
+1 KILL A1,A2
IF $DATA(^DD(B0,DA,1,DQ,3))
SET A2=^(3)
IF $DATA(^UTILITY("DDA",$JOB,B0,DA,3))
SET A1=^(3)
IF '$DATA(A1)&'$DATA(A2)
QUIT
+2 IF $DATA(A1)
IF $DATA(A2)
IF A1=A2
QUIT
DO ADD
SET ^DDA(B0,%D,1)=A1
SET ^(2)=A2
QUIT
+3 DO ADD
IF $DATA(A1)
SET ^DDA(B0,%D,1)=A1
IF $DATA(A2)
SET ^DDA(B0,%D,2)=A2
QUIT
+4 ;;
