source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPCF1.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1DGRPCF1 ;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
41 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
7LN 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
12LNL S L=E F I=0:0 S E=$O(^DGIN(38.5,E)) G:E="" Q S L=E
13 S E=L
14SET S $P(^DGIN(38.5,0),"^",3)=E I DGEDCN S DGCON=2 D TIME^DGRPC
15Q 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 ;
17XRS 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
19INC 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
21RXR 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
Note: See TracBrowser for help on using the repository browser.