Last change
on this file since 1800 was 642, checked in by Sam Habiel, 15 years ago |
Modified directory structure; moved routines.
|
File size:
840 bytes
|
Rev | Line | |
---|
[641] | 1 | XBDAD0 ; IHS/ADC/GTH - SET ALTERNATE DA/D0 ; [ 02/07/97 3:02 PM ]
|
---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
| 3 | ;
|
---|
| 4 | ; This routine sets the DA array from D0,D1 etc. or D0,D1
|
---|
| 5 | ; etc. from the DA array. If the variable XBDAD0=2 it sets
|
---|
| 6 | ; the DA array, otherwise it sets D0,D1 etc.
|
---|
| 7 | ;
|
---|
| 8 | ; The variable XBDAD0 will be killed upon exiting this
|
---|
| 9 | ; routine.
|
---|
| 10 | ;
|
---|
| 11 | ; The entry point KILL kills D0, D1, etc.
|
---|
| 12 | ;
|
---|
| 13 | START ;
|
---|
| 14 | NEW I,J
|
---|
| 15 | I $G(XBDAD0)=2 D D0DA I 1
|
---|
| 16 | E D DAD0
|
---|
| 17 | KILL XBDAD0
|
---|
| 18 | Q
|
---|
| 19 | ;
|
---|
| 20 | DAD0 ; ----- Set D0 (etc) from DA array.
|
---|
| 21 | F I=1:1 Q:'$D(DA(I)) S I(99-I)=DA(I)
|
---|
| 22 | S J=0
|
---|
| 23 | F I=0:1 S J=$O(I(J)) Q:J'=+J S @("D"_I)=I(J)
|
---|
| 24 | S @("D"_I)=DA
|
---|
| 25 | Q
|
---|
| 26 | ;
|
---|
| 27 | D0DA ; ----- Set DA array from D0 (etc).
|
---|
| 28 | F I=0:1 Q:'$D(@("D"_I)) S J=I
|
---|
| 29 | F I=0:1 S DA(J)=@("D"_I) S J=J-1 Q:J<1
|
---|
| 30 | S DA=@("D"_(I+1))
|
---|
| 31 | Q
|
---|
| 32 | ;
|
---|
| 33 | KILL ;PEP - KILL D0, D1, ETC.
|
---|
| 34 | NEW I
|
---|
| 35 | F I=0:1 Q:'$D(@("D"_I)) KILL @("D"_I)
|
---|
| 36 | Q
|
---|
| 37 | ;
|
---|
Note:
See
TracBrowser
for help on using the repository browser.