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

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1DGDDC ;ALB/MRL - X-ECUTE KILL X-REFERENCES [PATIENT] ;25 JUL 88@1337
2 ;;5.3;Registration;**489,244,527,700,673**;Aug 13, 1993
3 ;
4 Q:$D(DGNOFDEL) ;Flag variable to prevent deletion cascade
5 ;
6 Q:'$D(DGXRF) N DGXRFX,DGXRF1,DGXRF2,DGXRF3,DGXRF3,DGXRF4,DGXRF5,DGXRF6,DGXRF7,DGXRF8,DGXRFP,DGXRFX
7 S DGXRFX=X,DGXRF1=+$P(DGXRF,".",2),DGXRF2=$P($T(@DGXRF1),";;",2) G Q:DGXRF2=""
8 I $D(^DD(2,DGXRF,0)) S DGXRFP=$P(^(0),"^",4),DGXRF6=$P(DGXRFP,";",2),DGXRF5=$P(DGXRFP,";",1) I $D(^DPT(DA,DGXRF5)),($P(^(DGXRF5),"^",DGXRF6)=DGXRFX) G Q
9 I DGXRF=".1212",($D(^DPT(DA,DGXRF5))),($P(^(DGXRF5),"^",DGXRF6)="") S DGFDA(2,DA_",",.1213)="" D FILE^DIE("","DGFDA","DGERR") K DGFDA,DGERR G Q
10 N DGFDA,DGERR
11 ;F DGXRF3=1:1 S DGXRF4=$P(DGXRF2,"^",DGXRF3) Q:DGXRF4="" I $D(^DD(2,DGXRF4,0)) S DGXRF5=$P(^(0),"^",4),DGXRF6=$P(DGXRF5,";",2),DGXRF5=$P(DGXRF5,";",1) I $D(^DPT(DA,DGXRF5)),$P(^(DGXRF5),"^",DGXRF6)'="" D KILL
12 F DGXRF3=1:1 S DGXRF4=$P(DGXRF2,"^",DGXRF3) Q:DGXRF4="" I $D(^DD(2,DGXRF4,0)) S DGXRF5=$P(^(0),"^",4),DGXRF6=$P(DGXRF5,";",2),DGXRF5=$P(DGXRF5,";",1) I $D(^DPT(DA,DGXRF5)),$P(^(DGXRF5),"^",DGXRF6)'="",DGXRF4'=".1212" D
13 .I DGXRF4'=".1213" S DGFDA(2,DA_",",DGXRF4)=""
14 I $D(DGFDA) D FILE^DIE("","DGFDA","DGERR")
15Q S X=DGXRFX K DGXRF Q ;,DGXRFX,DGXRF1,DGXRF2,DGXRF3,DGXRF3,DGXRF4,DGXRF5,DGXRF6,DGXRF7,DGXRF8,DGXRFP,DGXRFX Q
16KILL S DGXRF7=$P(^DPT(DA,DGXRF5),"^",DGXRF6),$P(^DPT(DA,DGXRF5),"^",DGXRF6)=""
17 F DGXRF8=0:0 S DGXRF8=$O(^DD(2,DGXRF4,1,DGXRF8)) Q:'DGXRF8 I $D(^DD(2,DGXRF4,1,DGXRF8,2)) S X=DGXRF7 X:^(2)'["DGXRF" ^(2) D SET I $D(^DD(2,DGXRF4,1,DGXRF8,1)) D SET
18 Q
19SET Q:^DD(2,DGXRF4,1,DGXRF8,1)'["DGXRF" S X="" X ^(1) Q
20 ;
21152 ;;.1651^.1653^.1654^.1656^.307^
22153 ;;.1657^.1658^.1659^
23211 ;;.212^.2125^.213^.214^.215^.216^.217^.218^.219^.21011^.2207^
242191 ;;.2192^.21925^.2193^.2194^.2195^.2196^.2197^.2198^.2199^.211011^.2203^
25251 ;;.252^.253^.254^.255^.256^.257^.258^.2206^
263111 ;;.3113^.3114^.3115^.3116^.3117^.3118^.3119^.2205^
27331 ;;.332^.3305^.333^.334^.335^.336^.337^.338^.339^.33011^.2201^
283311 ;;.3312^.3313^.3314^.3315^.3316^.3317^.3318^.3319^.331011^.2204^
29341 ;;.342^.3405^.343^.344^.345^.346^.347^.348^.349^.34011^.2202^
303285 ;;.329^.3291^.3292^.3293^.3294^.32912^
3132945 ;;.3295^.3296^.3297^.3298^.3299^.32913^
323291 ;;.32912
333296 ;;.32913
34325 ;;.32911
35111 ;;.112^.113
36112 ;;.113
3712105 ;;.1217^.1218
381211 ;;.1212^.1213
391212 ;;.1213
4014105 ;;.1417^.1418
411411 ;;.1412^.1413
421412 ;;.1413
43213 ;;.214^.215
44214 ;;.215
452193 ;;.2194^.2195
462194 ;;.2195
47252 ;;.253^.254
48253 ;;.254
493113 ;;.3114^.3115
503114 ;;.3115
513313 ;;.3314^.3315
523314 ;;.3315
53333 ;;.334^.335
54334 ;;.335
55343 ;;.344^.345
56344 ;;.345
57361 ;;.3611
Note: See TracBrowser for help on using the repository browser.