| 1 | DGRPCF1 ;ALB/MRL - REMOVE INCONSISTENCIES FROM FILE; 21 SEP 88@2231
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | I '$D(^DGIN(38.5,DFN,0)) Q
|
|---|
| 4 | 1 W:DGEDCN !!,"===> Removing patient from Inconsistency file..." D START^DGRPC S DGF=38.51 D XRS D INC:DGXRC K DGXRC S DGF=38.5,DGD=^DGIN(38.5,DFN,0) D XRS D:DGXRC RXR
|
|---|
| 5 | K ^DGIN(38.5,DFN) L +^DGIN(38.5,0) S $P(^DGIN(38.5,0),"^",4)=$P(^(0),"^",4)-1 S X=$P(^(0),"^",3) G Q:DFN'=X S (P,N)=$P(^DPT(0),"^",3),A=$S($O(^DGIN(38.5,DFN))>0:1,1:0),X=DFN,G=$S(A:P,1:DFN),E1=0
|
|---|
| 6 | G Q:$O(^DGIN(38.5,N))'>0
|
|---|
| 7 | LN S N=N\2 S:A X=X+N S:'A X=X-N I X'>0 S E=P G LNL
|
|---|
| 8 | S E=$O(^DGIN(38.5,X)) I E>0,$O(^DGIN(38.5,E))'>0 G SET
|
|---|
| 9 | I E'>0 S A=0,G=$S(G>X:X,1:G) G LN
|
|---|
| 10 | I +E1,E1=E!(E1&('E)) S (G,X)=E,A=0 G LN
|
|---|
| 11 | S E1=E I E>0 S A=$S(+E>G:0,1:1) G LN
|
|---|
| 12 | LNL S L=E F I=0:0 S E=$O(^DGIN(38.5,E)) G:E="" Q S L=E
|
|---|
| 13 | S E=L
|
|---|
| 14 | SET S $P(^DGIN(38.5,0),"^",3)=E I DGEDCN S DGCON=2 D TIME^DGRPC
|
|---|
| 15 | Q L -^DGIN(38.5,0) K A,DA,DGD,DGD1,DGF,DGI,DGI1,DGXRC,E,E1,G,I,I1,L,N,P,X,X1 Q
|
|---|
| 16 | ;
|
|---|
| 17 | XRS S DGXRC=0 F I=0:0 S I=$O(^DD(DGF,I)) Q:'I F I1=0:0 S I1=$O(^DD(DGF,I,1,I1)) Q:'I1 I $D(^DD(DGF,I,1,I1,2)) S X=^(2),X1=+$P($P(^DD(DGF,I,0),"^",4),";",2),DGXRC(X1,I1)=X,DGXRC=DGXRC+1
|
|---|
| 18 | Q
|
|---|
| 19 | INC F DGI=0:0 S DGI=$O(^DGIN(38.5,DFN,"I",DGI)) Q:'DGI I $D(^(DGI,0)) S DGD=^(0) D RXR
|
|---|
| 20 | Q
|
|---|
| 21 | RXR F DGI=0:0 S DGI=$O(DGXRC(DGI)) Q:'DGI I $P(DGD,"^",DGI)]"" S DGD1=$P(DGD,"^",DGI) F DGI1=0:0 S DGI1=$O(DGXRC(DGI,DGI1)) Q:'DGI1 S X=DGD1,DA=$S(DGF=38.5:DFN,1:DGI) S:DGF=38.51 DA(1)=DFN X DGXRC(DGI,DGI1) K DA
|
|---|
| 22 | K DGI,DGI1,X,DGD1 Q
|
|---|
