source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAR02.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1LRAR02 ;DAL/HOAK COMPARE MAJOR HEADERS 062096 ; 12/12/96 10:16 ;
2 ;;5.2;LAB SERVICE;**111**;Sep 27, 1994
3INIT ;
4 ;
5 ;
6 ;----------------------------------------------------------------------
7 ;------Here is where we check the major header and force to perm.
8 ;
9CHECKX 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 ;
25SET ;
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 ;
35MORE ;
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
Note: See TracBrowser for help on using the repository browser.