| 1 | DGRPE4 ;ALB/GTS - REGISTRATIONS EDITS ; 5/25/05 08:53am
|
|---|
| 2 | ;;5.3;Registration;**624**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;DGDR contains a string of edits; edit=screen*10+item #
|
|---|
| 5 | ;
|
|---|
| 6 | ;line tag screen*10+item*1000 = continuation line
|
|---|
| 7 | ;
|
|---|
| 8 | N DGPH,DGPHFLG,UPARROUT
|
|---|
| 9 | S UPARROUT=0
|
|---|
| 10 | K DR S (DA,Y)=DFN,DIE="^DPT(",DR="",DGDRS="DR",DGCT=0
|
|---|
| 11 | I (DGDR["401") DO
|
|---|
| 12 | . S J1="A401"
|
|---|
| 13 | . S DGDRD=$P($T(@J1),";;",2)
|
|---|
| 14 | . D S
|
|---|
| 15 | . D ^DIE
|
|---|
| 16 | . I $D(Y)'=0 S UPARROUT=1
|
|---|
| 17 | . I UPARROUT=0 DO
|
|---|
| 18 | . . K DR,DA,Y,DIE
|
|---|
| 19 | . . S (DA,Y)=DFN,DIE="^DPT(",DR="",DGDRS="DR",DGCT=0
|
|---|
| 20 | . . S J1="B401"
|
|---|
| 21 | . . S DGDRD=$P($T(@J1),";;",2)
|
|---|
| 22 | . . D S
|
|---|
| 23 | . . S DIE("NO^")=""
|
|---|
| 24 | . . D ^DIE
|
|---|
| 25 | . . K DR,DA,Y,DIE
|
|---|
| 26 | . . N DGEMPST
|
|---|
| 27 | . . S DGEMPST=(+$P($G(^DPT(DFN,.311)),"^",15))
|
|---|
| 28 | . . I (DGEMPST]"")!(DGEMPST'=3)!(DGEMPST'=9) DO
|
|---|
| 29 | . . . S (DA,Y)=DFN,DIE="^DPT(",DR="",DGDRS="DR",DGCT=0
|
|---|
| 30 | . . . S J1="C401"
|
|---|
| 31 | . . . S DGDRD=$P($T(@J1),";;",2)
|
|---|
| 32 | . . . D S
|
|---|
| 33 | . . . D ^DIE
|
|---|
| 34 | K DR,DA,Y,DIE
|
|---|
| 35 | F Q:DGDR'["401," S DGDR=$P(DGDR,"401,")_""_$P(DGDR,"401,",2,999)
|
|---|
| 36 | I (UPARROUT=0)&(DGDR["402") DO
|
|---|
| 37 | . K DR S (DA,Y)=DFN,DIE="^DPT(",DR="",DGDRS="DR",DGCT=0
|
|---|
| 38 | . S J1="A402"
|
|---|
| 39 | . S DGDRD=$P($T(@J1),";;",2)
|
|---|
| 40 | . D S
|
|---|
| 41 | . D ^DIE
|
|---|
| 42 | . I $D(Y)'=0 S UPARROUT=1
|
|---|
| 43 | . I UPARROUT=0 DO
|
|---|
| 44 | . . K DR,DA,Y,DIE
|
|---|
| 45 | . . S (DA,Y)=DFN,DIE="^DPT(",DR="",DGDRS="DR",DGCT=0
|
|---|
| 46 | . . S J1="B402"
|
|---|
| 47 | . . S DGDRD=$P($T(@J1),";;",2)
|
|---|
| 48 | . . D S
|
|---|
| 49 | . . S DIE("NO^")=""
|
|---|
| 50 | . . D ^DIE
|
|---|
| 51 | . . K DR,DA,Y,DIE
|
|---|
| 52 | . . N DGEMPST
|
|---|
| 53 | . . S DGEMPST=(+$P($G(^DPT(DFN,.311)),"^",15))
|
|---|
| 54 | . . I (DGEMPST]"")!(DGEMPST'=3)!(DGEMPST'=9) DO
|
|---|
| 55 | . . . S (DA,Y)=DFN,DIE="^DPT(",DR="",DGDRS="DR",DGCT=0
|
|---|
| 56 | . . . S J1="C402"
|
|---|
| 57 | . . . S DGDRD=$P($T(@J1),";;",2)
|
|---|
| 58 | . . . D S
|
|---|
| 59 | . . . D ^DIE
|
|---|
| 60 | K DR,DA,Y,DIE
|
|---|
| 61 | F Q:DGDR'["402," S DGDR=$P(DGDR,"402,")_""_$P(DGDR,"402,",2,999)
|
|---|
| 62 | K DR,DA,Y,DIE
|
|---|
| 63 | Q
|
|---|
| 64 | S I $L(@DGDRS)+$L(DGDRD)<241 S @DGDRS=@DGDRS_DGDRD Q
|
|---|
| 65 | S DGCT=DGCT+1,DGDRS="DR(1,2,"_DGCT_")",@DGDRS=DGDRD Q
|
|---|
| 66 | Q
|
|---|
| 67 | A401 ;;.07;
|
|---|
| 68 | B401 ;;.31115;
|
|---|
| 69 | C401 ;;S DGST=$P(^DPT(DA,.311),"^",15);S:$S(DGST']"":1,DGST=3:1,DGST=9:1,1:0) Y=0 I Y=0 K DGST;S:($P(^DPT(DA,.311),"^",15)'=5) Y=.3111;.31116;.3111;S:X']"" Y="@41";.3113;S:X']"" Y=.3116;.3114;S:X']"" Y=.3116;.3115:.3117;.2205;.3119;@41;K DGST;
|
|---|
| 70 | A402 ;;.2514;
|
|---|
| 71 | B402 ;;.2515;
|
|---|
| 72 | C402 ;;S DGST=$P(^DPT(DA,.25),"^",15);S:$S(DGST']"":1,DGST=3:1,DGST=9:1,1:0) Y=0 I Y=0 K DGST;S:($P(^DPT(DA,.25),"^",15)'=5) Y=.251;.2516;.251;S:X']"" Y="@42";.252;S:X']"" Y=.255;.253;S:X']"" Y=.255;.254:.256;.2206;.258;@42;K DGST;
|
|---|
