| [613] | 1 | DGPMDDLD ;ALB/MRL - DETERMINE LODGER X-REF'S; 9 FEB 89
|
|---|
| 2 | ;;5.3;Registration;**54**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; -- lodger x-ref on ward field in
|
|---|
| 5 | I $S(('$D(DA)#2):1,'$D(DGPMDDF):1,'$D(DGPMDDT):1,1:0) G KX
|
|---|
| 6 | I DGPMDDF'=6,DGPMDDF'=7 G KX
|
|---|
| 7 | N DFN S DFN=+$P(^DGPM(+DA,0),"^",3) I '$D(^DPT(DFN,0)) G KX
|
|---|
| 8 | I 'DGPMDDT D @("K"_+DGPMDDF) G Q
|
|---|
| 9 | D FIND
|
|---|
| 10 | I $S('DGWD:1,1:$P(DGWD,"^",2)="") D G Q
|
|---|
| 11 | . N VAWD
|
|---|
| 12 | . D INPTCK^DGPMDDCN
|
|---|
| 13 | . I VAWD,($P(VAWD,"^",2)]"") D 1^DGPMDDCN Q
|
|---|
| 14 | . K X
|
|---|
| 15 | D @("S"_+DGPMDDF)
|
|---|
| 16 | G Q
|
|---|
| 17 | ;
|
|---|
| 18 | KX K X
|
|---|
| 19 | Q K DGPMX,DGPMX,DGWD,DGRM,DGMV,DGMV0,DGFLD,DGPMDD,DGPMDDF,DGPMDDT Q
|
|---|
| 20 | ;
|
|---|
| 21 | S6 ; -- ward x-ref
|
|---|
| 22 | S DGFLD=.107 I $D(^DPT(DFN,.107)) S DGPMX=^(.107) I DGPMX]"" K ^DGPM("LD",DGPMX,DA) D KILL^DGPMDDCN
|
|---|
| 23 | S DGPMX=$P(DGWD,"^",2),^DGPM("LD",DGPMX,DGMV)=""
|
|---|
| 24 | D SET^DGPMDDCN
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | K6 ;
|
|---|
| 28 | I X S W=$S($D(^DIC(42,+X,0)):$P(^(0),"^",1),1:"") I W]"" K ^DGPM("LD",W,DA) I $D(^DPT(DFN,.107)),^(.107)=W S DGPMX=W,DGFLD=.107 D KILL^DGPMDDCN
|
|---|
| 29 | K W
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | S7 S DGFLD=.108
|
|---|
| 33 | I $D(^DPT(DFN,.108)) S DGPMX=^(.108),DGFLD=.108 D KILL^DGPMDDCN F DGPMX1=0:0 S DGPMX1=+$O(^DGPM("ARM",DGPMX,DGPMX1)) D CHK I $T K ^DGPM("ARM",DGPMX,DGPMX1) Q
|
|---|
| 34 | S DGPMX=+DGRM D SET^DGPMDDCN:DGPMX
|
|---|
| 35 | I +DGRM S DGFLD=.108,DGPMX=+DGRM,^DGPM("ARM",DGPMX,DGMV)=1 D SET^DGPMDDCN
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | K7 I $D(^DPT(DFN,.108)),X=+^(.108) S DGPMX=X I $D(^DGPM("ARM",DGPMX,DA)) K ^(DA) S DGFLD=.108 D KILL^DGPMDDCN
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | CHK ;
|
|---|
| 42 | I '$D(^DGPM(DGPMX1,0)) Q
|
|---|
| 43 | I $P(^DGPM(DGPMX1,0),"^",3)=DFN Q
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | LD ; -- set "LD" x-ref for file #2 equal to corresp adm mv (#.107)
|
|---|
| 47 | N DFN,DGMV,DGMV0,DGX S DFN=DA
|
|---|
| 48 | S DGX=X D FIND S:$P(DGWD,U,2)=DGX ^DPT("LD",DGX,DFN)=DGMV
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | FIND ;
|
|---|
| 52 | D NOW^%DTC S DGID=9999999.999999-%,(DGMV,DGMV0)=0,(DGWD,DGRM)=""
|
|---|
| 53 | F DGID=DGID:0 S DGID=$O(^DGPM("ATID4",DFN,DGID)) Q:'DGID S DGMV=+$O(^(DGID,0)) I $D(^DGPM(DGMV,0)) S DGMV0=^(0) S:$S('$D(^DGPM(+$P(DGMV0,"^",17),0)):0,1:+^(0)'>%) (DGMV,DGMV0)=0 Q
|
|---|
| 54 | I $D(^DIC(42,+$P(DGMV0,"^",6),0)) S DGWD=$P(DGMV0,"^",6)_"^"_$P(^(0),"^")
|
|---|
| 55 | I $D(^DG(405.4,+$P(DGMV0,"^",7),0)) S DGRM=+$P(DGMV0,"^",7)_"^"_$P(^(0),"^")
|
|---|
| 56 | K DGID Q
|
|---|
| 57 | ;
|
|---|
| 58 | RESET ; -- reset ^DPT nodes and x-refs
|
|---|
| 59 | ; input: DFN
|
|---|
| 60 | ;
|
|---|
| 61 | ; -- kill data and x-refs
|
|---|
| 62 | I $D(^DPT(DFN,.107)) S DGPMX=^(.107),DGFLD=.107 I DGPMX]"" K ^DGPM("LD",DGPMX,DA) D KILL^DGPMDDCN
|
|---|
| 63 | I $D(^DPT(DFN,.108)) S DGPMX=^(.108),DGFLD=.108 D KILL^DGPMDDCN F DGPMX1=0:0 S DGPMX1=+$O(^DGPM("ARM",DGPMX,DGPMX1)) D CHK I $T K ^DGPM("ARM",DGPMX,DGPMX1) Q
|
|---|
| 64 | ; -- reset data and x-refs
|
|---|
| 65 | D FIND
|
|---|
| 66 | I $S('DGWD:1,1:$P(DGWD,"^",2)="") D G RESETQ
|
|---|
| 67 | . N VAWD
|
|---|
| 68 | . D INPTCK^DGPMDDCN
|
|---|
| 69 | . I VAWD,($P(VAWD,"^",2)]"") D RESET^DGPMDDCN
|
|---|
| 70 | D S6,S7
|
|---|
| 71 | ;
|
|---|
| 72 | RESETQ K DGWD,DGRM,DGPMX,DGPMX1,DGFLD,I,DGMV,DGMV0 Q
|
|---|
| 73 | ;
|
|---|
| 74 | XREF ;
|
|---|
| 75 | Q:$P(^DGPM(DA,0),U,2)'=4
|
|---|
| 76 | N DFN S DFN=+$P(^DGPM(DA,0),U,3) D RESET
|
|---|
| 77 | Q
|
|---|
