Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR138PO.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR138PO.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR138PO.m	(revision 636)
@@ -1,4 +1,21 @@
 LR138PO ;DALISC/FHS - LR*5.2*138 POST INSTALL ROUTINE KIDS INSTALL
- ;;5.2;LAB SERVICE;**138**;Sep 27, 1994
+ ;;5.2;LAB SERVICE;**138**;Sep 27, 1994;Build 4
+ ;Modified from FOIA VISTA,
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 EN ;Builds Laboratory OOS Locations for each LMIP valid WKLD Divison
  ;
@@ -15,5 +32,5 @@
  I 'LRPKG S LRPKG=$O(^DIC(9.4,"B","LAB SERVICE",0))
  I 'LRPKG D  G END
- .W !!$$CJ^XLFSTR("Not able to find 'LAB SERVICE' in your Package (#9.4) file.",80),!,$$CJ^XLFSTR("Contact your IRM Service !!",80),!!,$C(7) H 5 S XPDQUIT=2
+ .W !!,$$CJ^XLFSTR("Not able to find 'LAB SERVICE' in your Package (#9.4) file.",80),!,$$CJ^XLFSTR("Contact your IRM Service !!",80),!!,$C(7) H 5 S XPDQUIT=2
  . W !,$$CJ^XLFSTR("POST INSTALL ABORTED",80)
  W !!,$$CJ^XLFSTR("Creating Laboratory OOS Workload Locations",80),!!
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OB69.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OB69.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OB69.m	(revision 636)
@@ -1,4 +1,4 @@
 LR7OB69 ;slc/dcm/JAH - Get Lab order data from 69 - 68 - 63 ;8/10/04
- ;;5.2;LAB SERVICE;**121,187,224,291,373**;Sep 27, 1994;Build 1
+ ;;5.2;LAB SERVICE;**121,187,224,291**;Sep 27, 1994
  ;
 69(ODT,SN) ;Get data from file 69
@@ -33,5 +33,6 @@
  Q:'$D(^LR(+X0,0))  ;No matching entry in ^LR
  S:'$D(DFN) DFN=$P(^LR(+X0,0),"^",3) S:'$D(LRDFN) LRDFN=+X0 S:'$D(LRDPF) LRDPF=$P(^LR(+X0,0),"^",2)_$G(^DIC(+$P(^LR(+X0,0),"^",2),0,"GL"))
- S Y1=+XP1,Y2=$S($P(X1,"^"):$P(X1,"^"),1:$P(X0,"^",8)),Y3=$P(X0,"^",3),Y4=$P(X0,"^",4),Y5=$P(X0,"^",5),Y6=$P(X0,"^",6),Y7=$P(X0,"^",9),Y8=$P(X3,"^"),Y9=$P(X3,"^",2),Y11=$P(X0,"^",11),Y12=$P(X0,"^",2)
+ S Y1=+XP1,Y2=$S($P(X1,"^"):$P(X1,"^"),1:$P(X0,"^",8)),Y3=$P(X0,"^",3),Y4=$P(X0,"^",4),Y5=$P(X0,"^",5),Y6=$P(X0,"^",6),Y7=$P(X0,"^",7),Y8=$P(X3,"^"),Y9=$P(X3,"^",2),Y11=$P(X0,"^",11),Y12=$P(X0,"^",2)
+ S:$L(Y7) Y7=$O(^SC("C",Y7,0))
  ;canceled entries are skipped, so calls to this routine from options
  ;that are removing tests need to make the call before setting the pieces
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGG.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OGG.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGG.m	(revision 636)
@@ -1,4 +1,4 @@
 LR7OGG ;DALOI/STAFF- Interim report rpc grid ; Feb 9, 2005
- ;;5.2;LAB SERVICE;**187,290,364**;Sep 27, 1994;Build 3
+ ;;5.2;LAB SERVICE;**187,290**;Sep 27, 1994
  ;
 TEST ; test use only
@@ -32,5 +32,5 @@
  S ^TMP("LR7OGX",$J,"OUTPUT",1)="0^0^0^1"
  N ABCNT,ABDCNT,ABLINE,ABTCNT,ABTLINE,ADCNT,ADSEQ,AGE,ATCNT,ATSEQ,CDT,CHSUB,COMCNT,COMMENT,DATACNT,DATESEQ,DFN,EDATE,EDT,FLAG,IDT
- N LINE,LRCW,LRDFN,LRX,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO,INEXACT,DISPDATE
+ N LINE,LRCW,LRDFN,LRX,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO
  K ^TMP("LR7OG",$J)
  S DFN=+^TMP("LR7OGX",$J,"INPUT",1),SDATE=+$P(^(1),U,2),EDATE=+$P(^(1),U,3),ONLYSPEC=+$P(^(1),U,4)
@@ -56,5 +56,5 @@
  . S ZERO=^LR(LRDFN,"CH",IDT,0)
  . I '$P(ZERO,U,3) Q
- . S CDT=+ZERO,INEXACT=$P(ZERO,U,2),SPEC=+$P(ZERO,U,5),SPECNAME=$P($G(^LAB(61,SPEC,0)),U),COMMENT=$S($O(^LR(LRDFN,"CH",IDT,1,0)):"**",1:"")
+ . S CDT=+ZERO,SPEC=+$P(ZERO,U,5),SPECNAME=$P($G(^LAB(61,SPEC,0)),U),COMMENT=$S($O(^LR(LRDFN,"CH",IDT,1,0)):"**",1:"")
  . I ONLYSPEC,SPEC'=ONLYSPEC Q
  . S CHSUB=1
@@ -64,6 +64,5 @@
  . . . S DATESEQ=DATESEQ+1
  . . . S OUTCNT=OUTCNT+1
- . . . S DISPDATE=$S(INEXACT:CDT\1,1:CDT)
- . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT_U_DISPDATE
+ . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
  . . . I COMMENT'="" D
  . . . . S COMCNT=COMCNT+1
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMG.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OGMG.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMG.m	(revision 636)
@@ -1,8 +1,8 @@
 LR7OGMG ;DALOI/STAFF- Interim report rpc memo grid ;July 19, 2006
- ;;5.2;LAB SERVICE;**187,230,286,290,331,364**;Sep 27, 1994;Build 3
+ ;;5.2;LAB SERVICE;**187,230,286,290,331**;Sep 27, 1994;Build 7
  ;
 GRID(OUTCNT) ; from LR7OGMC
  N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
- N UNITS,VALUE,X,ZERO,INEXACT,DISPDATE
+ N UNITS,VALUE,X,ZERO
  ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
  K ^TMP("LRMPLS",$J)
@@ -13,9 +13,7 @@
  I '$P(ZERO,U,3) Q
  S SPEC=+$P(ZERO,U,5)
- S INEXACT=$P(ZERO,U,2),DISPDATE=$S(INEXACT:CDT\1,1:CDT)
  S DOC=$$NAME^LR7OGMP(+$P(ZERO,U,10))
  S ACC=$P(ZERO,U,6)
  S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
- S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,10)=DISPDATE
  S (TCNT,MPLS,PORDER,PLS)=0
  S PLS=$O(^TMP("LRPLS",$J,0))
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMM.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OGMM.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMM.m	(revision 636)
@@ -1,7 +1,7 @@
 LR7OGMM ;SLC/STAFF- Interim report rpc memo micro ;5/20/97  18:52
- ;;5.2;LAB SERVICE;**187,312,364**;Sep 27, 1994;Build 3
+ ;;5.2;LAB SERVICE;**187,312**;Sep 27, 1994
  ;
 MI(LRDFN,IDT,MICROSUB,ALL,OUTCNT,FORMAT,DONE) ; from LR7OGM
- N MISUB,OK,ZERO,INEXACT,DISPDATE,XDT
+ N MISUB,OK
  I '$D(^LR(LRDFN,"MI",IDT)) Q
  S OK=ALL
@@ -9,12 +9,5 @@
  I 'OK Q
  I $G(FORMAT) D
- .S XDT=9999999-IDT
- .S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="^MI^"_XDT D
- ..; determine if collection time is "inexact" and put the 
- ..; collection day/time that is to be displayed in piece 10
- ..S ZERO=$G(^LR(LRDFN,"MI",IDT,0)) Q:ZERO=""
- ..S INEXACT=$P(ZERO,U,2)
- ..S DISPDATE=$S(INEXACT:XDT\1,1:XDT)
- ..S $P(^TMP("LR7OGX",$J,"OUTPUT",OUTCNT),U,10)=DISPDATE
+ .S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="^MI^"_(9999999-IDT)
  .S OUTCNT=OUTCNT+1
  .S DONE=1
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMP.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OGMP.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMP.m	(revision 636)
@@ -1,4 +1,4 @@
-LR7OGMP ;DALOI/STAFF- Interim report rpc memo print ; Mar 10, 2003
- ;;5.2;LAB SERVICE;**187,246,282,286,344**;Sep 27, 1994
+LR7OGMP ;DALOI/STAFF- Interim report rpc memo print ;10/10/07  11:52
+ ;;5.2;LAB SERVICE;**187,246,282,286,344**;Sep 27, 1994;Build 2
  ;
 PRINT(OUTCNT) ; from LR7OGMC
@@ -27,5 +27,7 @@
  .. S TESTNUM=+DATA,PRNTCODE=$P(DATA,U,5),SUB=$P(DATA,U,6),FLAG=$P(DATA,U,8),X=$P(DATA,U,7),UNITS=$P(DATA,U,9),RANGE=$P(DATA,U,10),SITE=$P(DATA,U,11)
  .. S LOW=$P(RANGE,"-"),HIGH=$P(RANGE,"-",2),THER=$P(DATA,U,12)
- .. S LINE="     "_$S($L($P(DATA,U,2))>20:$P(DATA,U,3),1:$P(DATA,U,2))
+ .. ;S LINE="     "_$S($L($P(DATA,U,2))>20:$P(DATA,U,3),1:$P(DATA,U,2))
+ .. I $L($P(DATA,U,2))>28,$P(DATA,U,3)'="" S LINE=$P(DATA,U,3)
+ .. E  S LINE=$E($P(DATA,U,2),1,28)
  .. S LINE=$$SETSTR^VALM1("",LINE,28,0)
  .. I PRNTCODE="" S LINE=LINE_$J(X,8)
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OSUM1.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OSUM1.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OSUM1.m	(revision 636)
@@ -1,4 +1,4 @@
-LR7OSUM1 ;DALOI/dcm - Silent Patient cum cont. ; Mar 11, 2003
- ;;5.2;LAB SERVICE;**121,187,256,286**;Sep 27, 1994
+LR7OSUM1 ;DALOI/dcm - Silent Patient cum cont. ;10/10/07  11:51
+ ;;5.2;LAB SERVICE;**121,187,256,286**;Sep 27, 1994;Build 2
  ;
 LRIDT ; from LR7OSUM
@@ -90,5 +90,8 @@
  S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=$P(LRTRES,"^")_U_LRSPM_U_LRTST_U_$P(LRTRES,"^",2)_U_LRSUB_U_$P(LRTRES,"^",3,6)
  ;
- S X=$S($D(^LAB(60,LRTST,.1)):$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^")),^TMP("LRT",$J,X)="MISCELLANEOUS TESTS"
+ ; S X=$S($D(^LAB(60,LRTST,.1)):$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^")),^TMP("LRT",$J,X)="MISCELLANEOUS TESTS"
+ S TST=$P($G(^LAB(60,LRTST,.1)),"^")
+ I TST="" S TST=$P(^LAB(60,LRTST,0),"^")
+ S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS"
  ;
  ; Grab specimen comments
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OSUM6.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OSUM6.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OSUM6.m	(revision 636)
@@ -1,4 +1,4 @@
-LR7OSUM6 ;DALOI/dcm - Silent Patient cum cont. ;Mar 11, 2003
- ;;5.2;LAB SERVICE;**121,201,187,286,356**;Sep 27, 1994;Build 8
+LR7OSUM6 ;DALOI/dcm - Silent Patient cum cont. ;10/10/07  19:26
+ ;;5.2;LAB SERVICE;**121,201,187,286,356**;Sep 27, 1994;Build 2
  ;
 LRUDT(X) ;Get output date/time
@@ -43,5 +43,8 @@
  S LRSPEM=$S($L(LRSPE):$P(^LAB(61,LRSPE,0),U,1),1:"")
  G:'LRTEST COMM
- S LRNAME=$P(^LAB(60,LRTEST,.1),U,1)
+ S LRNAME=$P(^LAB(60,LRTEST,0),"^")
+ I $L(LRNAME)>13,$P($G(^LAB(60,LRTEST,.1)),"^")'="" S LRNAME=$P(^LAB(60,LRTEST,.1),"^")
+ E  S LRNAME=$E(LRNAME,1,13)
+ ; S LRNAME=$P(^LAB(60,LRTEST,.1),U,1)
  ;S:$L(LRSPE)&($D(^LAB(60,LRTEST,1,LRSPE,0))) X=^(0),@("LRLO="_$S($L($P(X,U,2)):$P(X,U,2),1:"""""")),@("LRHI="_$S($L($P(X,U,3)):$P(X,U,3),1:"""""")),LRUNT=$P(X,U,7)
  ;
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OV0.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OV0.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OV0.m	(revision 636)
@@ -1,4 +1,4 @@
 LR7OV0 ;slc/dcm - Update orderable items ;8/11/97
- ;;5.2;LAB SERVICE;**121,187,357,361**;Sep 27, 1994
+ ;;5.2;LAB SERVICE;**121,187,357,361**;Sep 27, 1994;Build 2
  ;
 TEST(TEST,ICNT) ;Process single test
@@ -41,4 +41,5 @@
  Q MFI
 SINGLE(TEST,MFICODE,MFECODE) ;Message for a single test
+ L +LR7OV0(TEST)
  ;TEST= ptr to test in file 60
  ;MFICODE=File Level Event Code
@@ -50,4 +51,5 @@
  ;W !!,$P(^LAB(60,TEST,0),"^"),! I $D(ORUPDMSG(3)) ZW ORUPDMSG
  I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message
+ L -LR7OV0(TEST)
  Q
 ADD(TEST) ;Add single record to Master file
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRAPBR1.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRAPBR1.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRAPBR1.m	(revision 636)
@@ -1,4 +1,4 @@
 LRAPBR1 ;DALOI/WTY/KLL;AP Browser Print Cont.;11/08/01
- ;;5.2;LAB SERVICE;**259,317,363**;Sep 27, 1994;Build 3
+ ;;5.2;LAB SERVICE;**259,317**;Sep 27, 1994
  ;
  ;
@@ -101,5 +101,4 @@
  .S X=$T(FIELDS+LRCNT)
  .S LRV=$P(X,";",2),LRV1=$P(X,";",3),LRV2=$P(X,";",4)
- .D TEXTCHK
  .I $P($G(^LR(LRDFN,LRSS,LRI,LRV,0)),U,4) D
  ..D GLENTRY("","",1),GLENTRY(LR(69.2,LRV1),"",1)
@@ -252,15 +251,2 @@
  ;1.1;.04;4
  ;1.4;.14;5
-TEXTCHK ; update text line counter if it is missing (Remedy 116253)
- N I,X,DATA
- S I=0
- K ^TMP("WP",$J)
- S X=$G(^LR(LRDFN,LRSS,LRI,LRV,0))
- I X'="",$L(X,"^")=1 D
- . F  S I=$O(^LR(LRDFN,LRSS,LRI,LRV,I)) Q:I=""  D
- . . S DATA=$G(^LR(LRDFN,LRSS,LRI,LRV,I,0))
- . . S ^TMP("WP",$J,I,0)=DATA
- I $D(^TMP("WP",$J)) D
- . D WP^DIE(63.08,LRI_","_LRDFN_",",LRV,"","^TMP(""WP"",$J)")
- . K ^TMP("WP",$J)
- Q
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSPT.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRSPT.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSPT.m	(revision 636)
@@ -1,4 +1,4 @@
 LRSPT ;AVAMC/REG/WTY - AP PRELIMINARY REPORTS ;10/16/01
- ;;5.2;LAB SERVICE;**1,72,248,259,373**;Sep 27, 1994;Build 1
+ ;;5.2;LAB SERVICE;**1,72,248,259**;Sep 27, 1994
  ;
  ;Reference to ^%DT supported by IA #10003
@@ -67,5 +67,5 @@
  K ^UTILITY($J) S DIWR=IOM-5,DIWF="W",LR("A")=0
  W ! F LRZ=0:1 S LR("A")=$O(^LRO(69.2,LRAA,10,LR("A"))) Q:'LR("A")  D
- .D:$Y>(IOSL-13) F^LRAPF,H S X=^LRO(69.2,LRAA,10,LR("A"),0) D ^DIWP
+ .D:$Y>(IOSL-6) H S X=^LRO(69.2,LRAA,10,LR("A"),0) D ^DIWP
  D:LRZ ^DIWW
  S LRO=1 D F^LRAPF
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSRVR6.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSRVR6.m	(revision 636)
@@ -1,4 +1,4 @@
 LRSRVR6 ;DALIO/JMC - LAB DATA SERVER CONT'D SNOMED EXTRACT ;Aug 17, 2006
- ;;5.2;LAB SERVICE;**346,378**;Sep 27, 1994;Build 1
+ ;;5.2;LAB SERVICE;**346**;Sep 27, 1994;Build 10
  ; Produces SNOMED extract via LRLABSERVER option
  ;
@@ -119,5 +119,4 @@
  S LRINSTR("ADDR FLAGS")="R"
  S LRINSTR("FROM")="LAB_PACKAGE"
- S LRMSUBJ=$E(LRMSUBJ,1,65)
  D SENDMSG^XMXAPI(.5,LRMSUBJ,"^TMP($J,""LRDATA"")",.LRTO,.LRINSTR,.LRTASK)
  Q
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRVER3A.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRVER3A.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRVER3A.m	(revision 636)
@@ -1,4 +1,4 @@
 LRVER3A ;SLC/CJS/DALOI/FHS - DATA VERIFICATION ;5/27/03  14:49
- ;;5.2;LAB SERVICE;**1,5,42,100,121,153,190,221,254,263,266,274,295,373**;Sep 27, 1994;Build 1
+ ;;5.2;LAB SERVICE;**1,5,42,100,121,153,190,221,254,263,266,274,295**;Sep 27, 1994
  ;Also contains LRORFLG to restrict multiple OERR alerts (VER+2)
  ; Reference to ^DIC(42 supported by IA #10039
@@ -12,5 +12,5 @@
  S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),(LRAOD,LRACD)=$P(^(0),U,3)
  S LRACD=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,9)):^(9),1:LRACD)
- S:'($D(^LRO(68,LRAA,1,LRACD,1,LRAN,0))#2) LRACD=LRAD
+ S:'$D(^LRO(68,LRAA,1,LRACD,1,LRAN,0))#2 LRACD=LRAD
  S LRAOD=$S($D(^LRO(68,LRAA,1,LRAOD,1,LRAN,0))#2:LRAOD,1:LRAD)
  I '$G(LRFIX) S LRNOW=$$NOW^XLFDT,$P(^LR(LRDFN,LRSS,LRIDT,0),U,3,4)=LRNOW_U_$S($G(LRDUZ):LRDUZ,1:DUZ)
@@ -38,5 +38,5 @@
  ;-I $P(^LR(LRDFN,0),U,2)=2 I '$D(ZZCARE) S ZRECORD=0,ZRECORD=$O(^SC("C",LRLLOC,ZRECORD)) I ZRECORD'="",$D(^LRTXFCS(5000024,1,618001,"B",ZRECORD)) D FCS  ; CJS/MPLS 3-16-92 LINE ADDED TO CHECK IF REQUESTING LOCATION IS CAREVUE SUPPORTED  ++RG
  S D1=1,X=0 F  S X=$O(^TMP("LR",$J,"TMP",X)) Q:X<1  S LRT=+^(X) I $D(LRM(X)) D REQ
- I $D(^LRO(69,LRODT,1,LRSN,0)) S ^(3)=$S($D(^(3)):+^(3),1:LRNOW) S:'$P(^(3),U,2) $P(^(3),U,2)=LRNOW
+ S:$D(^LRO(69,LRODT,1,LRSN,0)) ^(3)=$S($D(^(3)):+^(3),1:LRNOW) S:'$P(^(3),U,2) $P(^(3),U,2)=LRNOW
  I D1,'$D(A2) S:'$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4) $P(^(3),U,4)=LRNOW,^LRO(68,LRAA,1,LRAD,1,"AC",LRNOW,LRAN)=""
  ; Class I CareVue routine TASKED if CareVue ward - pwc/10-2000
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRVER4.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRVER4.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRVER4.m	(revision 636)
@@ -1,3 +1,3 @@
-LRVER4 ;DALOI/CJS/DALOI/FHS - LAB ROUTINE DATA VERIFICATION ;8/11/97
+LRVER4 ;DALOI/CJS/DALOI/FHS - LAB ROUTINE DATA VERIFICATION ; 7/28/05 3:08pm
  ;;5.2;LAB SERVICE;**14,42,112,121,140,171,153,188,279,283,286**;Sep 27, 1994
  ;
@@ -10,5 +10,6 @@
  . W !!,PNM,"  SSN: ",SSN,"   " S LRLCT=LRLCT+1
  . I LRDPF=2 W "   LOC: ",$S(LRWRD'="":LRWRD,1:$S($L($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)):$P(^(0),U,7),1:"??"))
- ;
+ ; VOE Fix for an error ;RED; 7/28/05
+ I $G(SEX)="" S SEX=""
  W !,"Pat Info: ",$P($G(^LR(LRDFN,.091)),U)
  W ?34," Sex: ",$S(SEX="M":"MALE",SEX="F":"FEMALE",1:SEX)
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRWLST1.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRWLST1.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRWLST1.m	(revision 636)
@@ -1,4 +1,4 @@
 LRWLST1 ;DALOI/CJS/RWF/FHS - ACCESSION SETUP ; July 19, 2006
- ;;5.2;LAB SERVICE;**48,65,121,153,261,286,331,379**;Sep 27, 1994;Build 2
+ ;;5.2;LAB SERVICE;**48,65,121,153,261,286,331**;Sep 27, 1994;Build 7
  ;
  ; Reference to ^DIC(42 supported by IA #10039
@@ -99,15 +99,5 @@
  . S FDA(2,68.05,"+1,"_LR6802,.01)=LRSPEC
  . S FDA(2,68.05,"+1,"_LR6802,1)=$P(LRSAMP,";",1)
- . ;
- . ; Modification to prevent lock failures - loop 10 times to give system a chance to get lock
- . N LRLOCKOK,LRLOOPCT
- . S LRLOCKOK=0
- . F LRLOOPCT=1:1:10 Q:LRLOCKOK  D  I 'LRLOCKOK H 5
- . . K LRDIE(2)
- . . D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)")
- . . S:$D(LRDIE(2))=0 LRLOCKOK=1
- . K LRLOCKOK,LRLOOPCT
- . ;
- . ;D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)")
+ . D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)")
  . I $D(LRDIE(2)) D MAILALRT
  ;
@@ -287,15 +277,5 @@
  S FDAIEN(1)=LRAN
  S FDA(2,68.02,"+1,"_LR6802,.01)=LRDFN
- ;
- ; Modification to prevent lock failures - loop 10 times to give system a chance to get lock
- N LRLOCKOK,LRLOOPCT
- S LRLOCKOK=0
- F LRLOOPCT=1:1:10 Q:LRLOCKOK  D  I 'LRLOCKOK H 5
- . K LRDIE(2)
- . D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)")
- . S:$D(LRDIE(2))=0 LRLOCKOK=1
- K LRLOCKOK,LRLOOPCT
- ;
- ;D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)")
+ D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)")
  I $D(LRDIE(2)) D MAILALRT
  Q
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRWLST11.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRWLST11.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRWLST11.m	(revision 636)
@@ -1,4 +1,4 @@
 LRWLST11 ;DALOI/CJS,RWF/FHS - ACCESSION SETUP ;July 19, 2006
- ;;5.2;LAB SERVICE;**121,128,153,202,286,331,375**;Sep 27, 1994;Build 3
+ ;;5.2;LAB SERVICE;**121,128,153,202,286,331**;Sep 27, 1994;Build 7
  ;
 ST21 ;
@@ -12,5 +12,5 @@
  ; when tests are acessioned to the 'in common' area.
  I +LRWLC,+LRWLC'=+LRAA,$G(^LRO(68,LRWLC,1,LRAD,1,LRAN,0))=$G(LRDFN) D
- . I 'LRUNQ,$D(LRTSTS(LRWLC,LRUNQ,LRWLC)) Q
+ . I $D(LRTSTS(LRWLC,LRUNQ,LRWLC)) Q
  . Q:$G(^LRO(68,LRWLC,1,LRAD,1,LRAN,.1))
  . N LRAA,LRACC,LRCDTX,LRCOMMON,LREND,LRIDT,LRNODE3,LRORDRR,LRORU3,LRQUIET,LRTJ,LRUID,X,Y
Index: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRX.m
===================================================================
--- FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRX.m	(revision 631)
+++ FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRX.m	(revision 636)
@@ -1,4 +1,4 @@
-LRX ;SLC/BA/DALISC/FHS - UTILITY ROUTINES -- PREVIOUSLY ^LAB("X","...") ;2/8/91  07:30
- ;;5.2;LAB SERVICE;**65,153,201,217,290,360**;Sep 27, 1994;Build 1
+LRX ;SLC/BA/DALISC/FHS - UTILITY ROUTINES -- PREVIOUSLY ^LAB("X","...") ;1/26/07  18:36
+ ;;5.2;LAB SERVICE;**65,153,201,217,290,360,350**;Sep 27, 1994;Build 10
 PT ;patient info
  ;
@@ -23,5 +23,6 @@
  . . S SEX=$P(VADM(5),U),DOB=$P(VADM(3),U),DOD=$P(VADM(6),U)
  . . S AGE=VADM(4),AGE(2)=$$AGE2(DOB,$G(LRCDT))
- . . S SSN=$P(VADM(2),U),LRWRD=$P(VAIN(4),U,2)
+ . . ; S SSN=$P(VADM(2),U),LRWRD=$P(VAIN(4),U,2)
+ . . S SSN=VA("PID"),LRWRD=$P(VAIN(4),U,2) ; for VOE
  . . S LRWRD(1)=+VAIN(4),LRRB=VAIN(5),LRPRAC=+VAIN(2)
  . . S:VAIN(3) LRTREA=+VAIN(3)
@@ -43,5 +44,6 @@
  . D DEM^VADPT D:'VAERR
  . . S PNM=VADM(1),SEX=$P(VADM(5),U)
- . . S DOB=$P(VADM(3),U),SSN=$P(VADM(2),U)
+ . . ; S DOB=$P(VADM(3),U),SSN=$P(VADM(2),U)
+ . . S DOB=$P(VADM(3),U),SSN=VA("PID") ; for VOE
  . . S AGE=VADM(4),AGE(2)=$$AGE2(DOB,$G(LRCDT))
  D SSNFM^LRU
