| [613] | 1 | LRAR02 ;DAL/HOAK COMPARE MAJOR HEADERS 062096 ; 12/12/96 10:16 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**111**;Sep 27, 1994
|
|---|
| 3 | INIT ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | ;----------------------------------------------------------------------
|
|---|
| 7 | ;------Here is where we check the major header and force to perm.
|
|---|
| 8 | ;
|
|---|
| 9 | CHECKX S LRMH=$P($P(LRDAT,U,9),":") ;Major Header
|
|---|
| 10 | S LRFG=$P($P(LRDAT,U,9),":",2) ;PAGE
|
|---|
| 11 | ;
|
|---|
| 12 | ; Checking all the test for different major header
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | S TEST=.5
|
|---|
| 16 | F S TEST=$O(^LR(LRDFN,"CH",LRIDT,TEST)) Q:+TEST'>0 D
|
|---|
| 17 | . Q:$D(^TMP("LRT2",TEST))#2
|
|---|
| 18 | . D SET
|
|---|
| 19 | ;--------------------------------------------------------------------
|
|---|
| 20 | ;
|
|---|
| 21 | ;
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | SET ;
|
|---|
| 26 | ;
|
|---|
| 27 | ;W !!,"I'VE CROSSED OVER......."
|
|---|
| 28 | S LRT1="^LAB(64.5,1,1)"
|
|---|
| 29 | F S LRT1=$Q(@LRT1) Q:+$P(LRT1,",",2)'>0 D
|
|---|
| 30 | . I $P(@LRT1,";",2)=TEST S LRMHX=$P(LRT1,",",4) Q:'LRMHX D
|
|---|
| 31 | .. ;W !,"TEST=",TEST," ",$P(LRT1,",",4),"<---64.5 ^LR--->",LRMH R VVVV
|
|---|
| 32 | .. I LRMH'=LRMHX D MORE
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | MORE ;
|
|---|
| 36 | ;S LRIDT=0
|
|---|
| 37 | S:'$D(^TMP("LRT2",TEST))#2 ^(TEST)=""
|
|---|
| 38 | ;F S LRIDT=$O(^LRO(68,"AC",LRDFN,LRIDT)) Q:LRIDT<1 D
|
|---|
| 39 | ;-----------------------------------------------------------------
|
|---|
| 40 | I $E(IOST,1,2)="C-" D
|
|---|
| 41 | . ;W !!,"Found a diferent major header. I will increment page now."
|
|---|
| 42 | ;
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | S ^LAR("DHZ",LRDFN,LRIDT,$P(^DD(63.04,TEST,0),U))=PNM_U_LRMH_U_LRMHX_U_(9999999-LRIDT)
|
|---|
| 46 | ;
|
|---|
| 47 | I '$D(^LR(LRDFN,"PG",LRMHX)) S ^LR(LRDFN,"PG",LRMHX)=LRMHX_U_1
|
|---|
| 48 | E S $P(^LR(LRDFN,"PG",LRMHX),U,2)=$P(^(LRMHX),U,2)+1
|
|---|
| 49 | S LRPG5=$P(^LR(LRDFN,"CH",LRIDT,0),U,9) I '$D(LRPG5) D QUIT
|
|---|
| 50 | . S LRPG5=$P(^LR(LRDFN,"PG",LRMHX),U)
|
|---|
| 51 | . S LRPG5=LRPG5_":"_$P(^LR(LRDFN,"PG",LRMHX),U,2) K LRPG5
|
|---|
| 52 | I $D(LRPG5) S $P(^LR(LRDFN,"CH",LRIDT,0),U,9)=$P($P(^(0),U,9),":",2)+1
|
|---|
| 53 | ;
|
|---|
| 54 | ;
|
|---|
| 55 | Q
|
|---|
