[613] | 1 | LRAC14 ;DALOI/DH/RLM-FIND LOCATION FOR MULTIPLE ABBREVIATION ;6/16/97 15:45
|
---|
| 2 | ;;5.2;LAB SERVICE;**272**;SEP 27, 1994
|
---|
| 3 | ; Reference to ^SC( supported by IA # 908
|
---|
| 4 | ; Reference to ^%DTC supported by IA # 10000
|
---|
| 5 | ; Reference to ^VADPT supported by IA # 10061
|
---|
| 6 | ; Reference to ^XMD supported by IA # 10070
|
---|
| 7 | INIT ;
|
---|
| 8 | Q:'$D(LRLLOC)
|
---|
| 9 | S LRODT=DT
|
---|
| 10 | Q:'$D(^LAB(64.58,"C"))
|
---|
| 11 | I '$G(LRLLIN) S LRLLIN=0
|
---|
| 12 | ;S LRLLIN=$O(^LAB(64.58,"C",LRLLOC,LRLLIN))
|
---|
| 13 | ;I +$G(LRLLIN)>0 QUIT
|
---|
| 14 | CNT S LRCNT9=$G(LRCNT9)+1
|
---|
| 15 | Q:'$G(LRDT)
|
---|
| 16 | S LRODT=LRDT
|
---|
| 17 | Q:'$D(^LRO(69,LRODT,1,"AR",LRLLOC))
|
---|
| 18 | S PNM1=$O(^LRO(69,LRODT,1,"AR",LRLLOC,""))
|
---|
| 19 | Q:'$D(^LRO(69,LRODT,1,"AR",LRLLOC,PNM1))
|
---|
| 20 | S LRDFN1=$O(^LRO(69,LRODT,1,"AR",LRLLOC,PNM1,0))
|
---|
| 21 | S DFN=$P(^LR(LRDFN1,0),U,3) D ^VADPT
|
---|
| 22 | Q:'$D(^LRO(69,LRODT,1,"AR",LRLLOC,PNM1,LRDFN1))
|
---|
| 23 | D CH D MI D BB D SP
|
---|
| 24 | ; ^LR(50954,"CH",7029381.94999,0) = 2970617.05001^^^^71^WUA 0616 30^^^^36560^WMHC
|
---|
| 25 | CH ;
|
---|
| 26 | S LRSUB="CH" D LR
|
---|
| 27 | D MAIL
|
---|
| 28 | K LRNODE
|
---|
| 29 | Q:LRLLIN=0 ;--> This happens when location is UNKNOWN
|
---|
| 30 | MI ;
|
---|
| 31 | Q:$G(LRLLIN)>0
|
---|
| 32 | S LRSUB="MI" D LR
|
---|
| 33 | Q
|
---|
| 34 | BB ;
|
---|
| 35 | Q:$G(LRLLIN)>0
|
---|
| 36 | S LRSUB="BB" D LR
|
---|
| 37 | Q
|
---|
| 38 | SP ;
|
---|
| 39 | Q:$G(LRLLIN)>0
|
---|
| 40 | S LRSUB="SP" D LR
|
---|
| 41 | Q
|
---|
| 42 | LR ;
|
---|
| 43 | Q:'$D(^LR(LRDFN1,LRSUB))
|
---|
| 44 | S LRIDT=$O(^LRO(69,LRODT,1,"AN",LRLLOC,LRDFN1,0)) Q:+LRIDT'>0 D
|
---|
| 45 | . I $D(^LR(LRDFN1,LRSUB,LRIDT,0)) S LRNODE=^LR(LRDFN1,LRSUB,LRIDT,0)
|
---|
| 46 | . Q:$G(LRNODE)=""
|
---|
| 47 | . S LRAD=9999999-LRIDT
|
---|
| 48 | . S LRAD=$P(LRAD,".")
|
---|
| 49 | . S LRACCN=$P(LRNODE,U,6)
|
---|
| 50 | . S LRAAN=$P(LRACCN," ") S LRAA=$O(^LRO(68,"B",LRAAN,0))
|
---|
| 51 | . Q:LRAA=""
|
---|
| 52 | . S LRAD=$S(LRSUB'="CH":$E(LRAD,1,3)_"0000",1:$E(LRAD,1,3)_$P(LRACCN," ",2))
|
---|
| 53 | . S LRAN=+$P(LRNODE," ",3)
|
---|
| 54 | . Q:LRAN'>0
|
---|
| 55 | . Q:LRAA'>0!(LRAD'>0)
|
---|
| 56 | . Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D LRO
|
---|
| 57 | ;
|
---|
| 58 | ;D END
|
---|
| 59 | Q
|
---|
| 60 | LRO ;
|
---|
| 61 | S LRLLIN=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,13)
|
---|
| 62 | ;W !,^SC(LRLLIN,0)
|
---|
| 63 | ;K LRLLIN
|
---|
| 64 | I '$G(LRLLIN) S ^TMP("LR","NO-LRLLIN",LRACCN,LRLLOC)="" D LRO69
|
---|
| 65 | Q
|
---|
| 66 | LRO69 ;
|
---|
| 67 | I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LRNODE=^(0) D
|
---|
| 68 | . S LRODT=$P(LRNODE,U,4),LRSN=$P(LRNODE,U,5)
|
---|
| 69 | . Q:$G(LRSN)'>0
|
---|
| 70 | . Q:'$D(^LRO(69,LRODT,1,LRSN,0))
|
---|
| 71 | . S LRLLIN=$P(^LRO(69,LRODT,1,LRSN,0),U,9)
|
---|
| 72 | ;K LRLLIN
|
---|
| 73 | I '$G(LRLLIN) D
|
---|
| 74 | . I '$G(PNM) S PNM=PNM1
|
---|
| 75 | . D PT^LRX S LRDATA=$G(PNM1)_U_$G(SSN)_U_$G(LRODT)_U_$G(DFN)
|
---|
| 76 | . S ^TMP("LR","LR-NO-LOC",LRLLOC)=LRDATA ;--->Send message
|
---|
| 77 | . D MAIL
|
---|
| 78 | Q
|
---|
| 79 | MAIL ;
|
---|
| 80 | ; Send a message to entries in G.LMI if the
|
---|
| 81 | ; location can't be found in ^SC
|
---|
| 82 | I $G(DUZ)'>0 S LRDUZ2=.5
|
---|
| 83 | I $G(LRDUZ2)'>0 S LRDUZ2=.5
|
---|
| 84 | S Y=0
|
---|
| 85 | S XMY("G.LMI")="" D
|
---|
| 86 | . S XMDUZ=LRDUZ2
|
---|
| 87 | . S XMTEXT="LRTXT("
|
---|
| 88 | . S LRTXT(1)="Flash... Have a problem with: "_$G(LRLLOC)_" "_$G(VADM(1))_" "_$G(VADM(2))_" For "_$G(LRODT)
|
---|
| 89 | . I $G(LRLLIN) S LRTXT(2)="I think it might be: "_$G(^SC(LRLLIN,0))
|
---|
| 90 | . S XMSUB="Problem resolving locations for cumulative."
|
---|
| 91 | . D ^XMD
|
---|
| 92 | QUIT
|
---|
| 93 | END ;
|
---|
| 94 | QUIT
|
---|
| 95 | K LRCNTCUM,LRSUB,LRDFN1,LRIDT,LRAD,LRAA,LRAN,LRACCN,LRAAN,LRODT,LRDUZ2
|
---|
| 96 | K LRTXT,LRTIME0,LRTIME9
|
---|
| 97 | Q
|
---|
| 98 | LOOK ;
|
---|
| 99 | S X=0
|
---|
| 100 | D NOW^%DTC S LRTIME0=%
|
---|
| 101 | S X=0
|
---|
| 102 | F S X=$O(^LAC("LRAC",X)) Q:X=""
|
---|
| 103 | D NOW^%DTC S LRTIME9=%
|
---|
| 104 | W LRTIME0," TO ",LRTIME9
|
---|
| 105 | ; in ^LRO
|
---|
| 106 | ; From that we get the LRDFN and look ^LR(LRDFN,"CH" or
|
---|
| 107 | ; ^LR(LRDFN,"MI"
|
---|
| 108 | ; fROM this we get the accn---Get the IEN from the accn area by
|
---|
| 109 | ; --------^LRO(68,"B","ABBRV")-----
|
---|
| 110 | ; The last peice of the 0 node is the IEN forn ^SC
|
---|
| 111 | ; Take that and look in the B x-ref of ^LAB(64.5,1,5,"B",IEN
|
---|
| 112 | ; ^LAB(64.5,1,5,"B",1870,422
|
---|
| 113 | ; and get the ien for the separate location and where it should
|
---|
| 114 | ; print
|
---|
| 115 | ; Lastly set LRLLIN VARABLE TO to the ien in ^SC
|
---|
| 116 | QUIT
|
---|