Changeset 636 for FOIAVistA/tag/r/LAB_SERVICE-LR-LS
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (15 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 17 edited
- 1 copied
-
. (copied) (copied from FOIAVistA/trunk/r )
-
LAB_SERVICE-LR-LS/LR138PO.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LR7OB69.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LR7OGG.m (modified) (4 diffs)
-
LAB_SERVICE-LR-LS/LR7OGMG.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LR7OGMM.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LR7OGMP.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LR7OSUM1.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LR7OSUM6.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LR7OV0.m (modified) (3 diffs)
-
LAB_SERVICE-LR-LS/LRAPBR1.m (modified) (3 diffs)
-
LAB_SERVICE-LR-LS/LRSPT.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LRSRVR6.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LRVER3A.m (modified) (3 diffs)
-
LAB_SERVICE-LR-LS/LRVER4.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LRWLST1.m (modified) (3 diffs)
-
LAB_SERVICE-LR-LS/LRWLST11.m (modified) (2 diffs)
-
LAB_SERVICE-LR-LS/LRX.m (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR138PO.m
r628 r636 1 1 LR138PO ;DALISC/FHS - LR*5.2*138 POST INSTALL ROUTINE KIDS INSTALL 2 ;;5.2;LAB SERVICE;**138**;Sep 27, 1994 2 ;;5.2;LAB SERVICE;**138**;Sep 27, 1994;Build 4 3 ;Modified from FOIA VISTA, 4 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 5 ;General Public License See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 3 20 EN ;Builds Laboratory OOS Locations for each LMIP valid WKLD Divison 4 21 ; … … 15 32 I 'LRPKG S LRPKG=$O(^DIC(9.4,"B","LAB SERVICE",0)) 16 33 I 'LRPKG D G END 17 .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=234 .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 18 35 . W !,$$CJ^XLFSTR("POST INSTALL ABORTED",80) 19 36 W !!,$$CJ^XLFSTR("Creating Laboratory OOS Workload Locations",80),!! -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OB69.m
r628 r636 1 1 LR7OB69 ;slc/dcm/JAH - Get Lab order data from 69 - 68 - 63 ;8/10/04 2 ;;5.2;LAB SERVICE;**121,187,224,291 ,373**;Sep 27, 1994;Build 12 ;;5.2;LAB SERVICE;**121,187,224,291**;Sep 27, 1994 3 3 ; 4 4 69(ODT,SN) ;Get data from file 69 … … 33 33 Q:'$D(^LR(+X0,0)) ;No matching entry in ^LR 34 34 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")) 35 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) 35 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) 36 S:$L(Y7) Y7=$O(^SC("C",Y7,0)) 36 37 ;canceled entries are skipped, so calls to this routine from options 37 38 ;that are removing tests need to make the call before setting the pieces -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGG.m
r628 r636 1 1 LR7OGG ;DALOI/STAFF- Interim report rpc grid ; Feb 9, 2005 2 ;;5.2;LAB SERVICE;**187,290 ,364**;Sep 27, 1994;Build 32 ;;5.2;LAB SERVICE;**187,290**;Sep 27, 1994 3 3 ; 4 4 TEST ; test use only … … 32 32 S ^TMP("LR7OGX",$J,"OUTPUT",1)="0^0^0^1" 33 33 N ABCNT,ABDCNT,ABLINE,ABTCNT,ABTLINE,ADCNT,ADSEQ,AGE,ATCNT,ATSEQ,CDT,CHSUB,COMCNT,COMMENT,DATACNT,DATESEQ,DFN,EDATE,EDT,FLAG,IDT 34 N LINE,LRCW,LRDFN,LRX,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO ,INEXACT,DISPDATE34 N LINE,LRCW,LRDFN,LRX,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO 35 35 K ^TMP("LR7OG",$J) 36 36 S DFN=+^TMP("LR7OGX",$J,"INPUT",1),SDATE=+$P(^(1),U,2),EDATE=+$P(^(1),U,3),ONLYSPEC=+$P(^(1),U,4) … … 56 56 . S ZERO=^LR(LRDFN,"CH",IDT,0) 57 57 . I '$P(ZERO,U,3) Q 58 . 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:"")58 . 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:"") 59 59 . I ONLYSPEC,SPEC'=ONLYSPEC Q 60 60 . S CHSUB=1 … … 64 64 . . . S DATESEQ=DATESEQ+1 65 65 . . . S OUTCNT=OUTCNT+1 66 . . . S DISPDATE=$S(INEXACT:CDT\1,1:CDT) 67 . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT_U_DISPDATE 66 . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT 68 67 . . . I COMMENT'="" D 69 68 . . . . S COMCNT=COMCNT+1 -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMG.m
r628 r636 1 1 LR7OGMG ;DALOI/STAFF- Interim report rpc memo grid ;July 19, 2006 2 ;;5.2;LAB SERVICE;**187,230,286,290,331 ,364**;Sep 27, 1994;Build 32 ;;5.2;LAB SERVICE;**187,230,286,290,331**;Sep 27, 1994;Build 7 3 3 ; 4 4 GRID(OUTCNT) ; from LR7OGMC 5 5 N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM 6 N UNITS,VALUE,X,ZERO ,INEXACT,DISPDATE6 N UNITS,VALUE,X,ZERO 7 7 ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges 8 8 K ^TMP("LRMPLS",$J) … … 13 13 I '$P(ZERO,U,3) Q 14 14 S SPEC=+$P(ZERO,U,5) 15 S INEXACT=$P(ZERO,U,2),DISPDATE=$S(INEXACT:CDT\1,1:CDT)16 15 S DOC=$$NAME^LR7OGMP(+$P(ZERO,U,10)) 17 16 S ACC=$P(ZERO,U,6) 18 17 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC 19 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,10)=DISPDATE20 18 S (TCNT,MPLS,PORDER,PLS)=0 21 19 S PLS=$O(^TMP("LRPLS",$J,0)) -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMM.m
r628 r636 1 1 LR7OGMM ;SLC/STAFF- Interim report rpc memo micro ;5/20/97 18:52 2 ;;5.2;LAB SERVICE;**187,312 ,364**;Sep 27, 1994;Build 32 ;;5.2;LAB SERVICE;**187,312**;Sep 27, 1994 3 3 ; 4 4 MI(LRDFN,IDT,MICROSUB,ALL,OUTCNT,FORMAT,DONE) ; from LR7OGM 5 N MISUB,OK ,ZERO,INEXACT,DISPDATE,XDT5 N MISUB,OK 6 6 I '$D(^LR(LRDFN,"MI",IDT)) Q 7 7 S OK=ALL … … 9 9 I 'OK Q 10 10 I $G(FORMAT) D 11 .S XDT=9999999-IDT 12 .S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="^MI^"_XDT D 13 ..; determine if collection time is "inexact" and put the 14 ..; collection day/time that is to be displayed in piece 10 15 ..S ZERO=$G(^LR(LRDFN,"MI",IDT,0)) Q:ZERO="" 16 ..S INEXACT=$P(ZERO,U,2) 17 ..S DISPDATE=$S(INEXACT:XDT\1,1:XDT) 18 ..S $P(^TMP("LR7OGX",$J,"OUTPUT",OUTCNT),U,10)=DISPDATE 11 .S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="^MI^"_(9999999-IDT) 19 12 .S OUTCNT=OUTCNT+1 20 13 .S DONE=1 -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMP.m
r628 r636 1 LR7OGMP ;DALOI/STAFF- Interim report rpc memo print ; Mar 10, 20032 ;;5.2;LAB SERVICE;**187,246,282,286,344**;Sep 27, 1994 1 LR7OGMP ;DALOI/STAFF- Interim report rpc memo print ;10/10/07 11:52 2 ;;5.2;LAB SERVICE;**187,246,282,286,344**;Sep 27, 1994;Build 2 3 3 ; 4 4 PRINT(OUTCNT) ; from LR7OGMC … … 27 27 .. 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) 28 28 .. S LOW=$P(RANGE,"-"),HIGH=$P(RANGE,"-",2),THER=$P(DATA,U,12) 29 .. S LINE=" "_$S($L($P(DATA,U,2))>20:$P(DATA,U,3),1:$P(DATA,U,2)) 29 .. ;S LINE=" "_$S($L($P(DATA,U,2))>20:$P(DATA,U,3),1:$P(DATA,U,2)) 30 .. I $L($P(DATA,U,2))>28,$P(DATA,U,3)'="" S LINE=$P(DATA,U,3) 31 .. E S LINE=$E($P(DATA,U,2),1,28) 30 32 .. S LINE=$$SETSTR^VALM1("",LINE,28,0) 31 33 .. I PRNTCODE="" S LINE=LINE_$J(X,8) -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OSUM1.m
r628 r636 1 LR7OSUM1 ;DALOI/dcm - Silent Patient cum cont. ; Mar 11, 20032 ;;5.2;LAB SERVICE;**121,187,256,286**;Sep 27, 1994 1 LR7OSUM1 ;DALOI/dcm - Silent Patient cum cont. ;10/10/07 11:51 2 ;;5.2;LAB SERVICE;**121,187,256,286**;Sep 27, 1994;Build 2 3 3 ; 4 4 LRIDT ; from LR7OSUM … … 90 90 S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=$P(LRTRES,"^")_U_LRSPM_U_LRTST_U_$P(LRTRES,"^",2)_U_LRSUB_U_$P(LRTRES,"^",3,6) 91 91 ; 92 S X=$S($D(^LAB(60,LRTST,.1)):$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^")),^TMP("LRT",$J,X)="MISCELLANEOUS TESTS" 92 ; S X=$S($D(^LAB(60,LRTST,.1)):$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^")),^TMP("LRT",$J,X)="MISCELLANEOUS TESTS" 93 S TST=$P($G(^LAB(60,LRTST,.1)),"^") 94 I TST="" S TST=$P(^LAB(60,LRTST,0),"^") 95 S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS" 93 96 ; 94 97 ; Grab specimen comments -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OSUM6.m
r628 r636 1 LR7OSUM6 ;DALOI/dcm - Silent Patient cum cont. ; Mar 11, 20032 ;;5.2;LAB SERVICE;**121,201,187,286,356**;Sep 27, 1994;Build 81 LR7OSUM6 ;DALOI/dcm - Silent Patient cum cont. ;10/10/07 19:26 2 ;;5.2;LAB SERVICE;**121,201,187,286,356**;Sep 27, 1994;Build 2 3 3 ; 4 4 LRUDT(X) ;Get output date/time … … 43 43 S LRSPEM=$S($L(LRSPE):$P(^LAB(61,LRSPE,0),U,1),1:"") 44 44 G:'LRTEST COMM 45 S LRNAME=$P(^LAB(60,LRTEST,.1),U,1) 45 S LRNAME=$P(^LAB(60,LRTEST,0),"^") 46 I $L(LRNAME)>13,$P($G(^LAB(60,LRTEST,.1)),"^")'="" S LRNAME=$P(^LAB(60,LRTEST,.1),"^") 47 E S LRNAME=$E(LRNAME,1,13) 48 ; S LRNAME=$P(^LAB(60,LRTEST,.1),U,1) 46 49 ;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) 47 50 ; -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OV0.m
r628 r636 1 1 LR7OV0 ;slc/dcm - Update orderable items ;8/11/97 2 ;;5.2;LAB SERVICE;**121,187,357,361**;Sep 27, 1994 2 ;;5.2;LAB SERVICE;**121,187,357,361**;Sep 27, 1994;Build 2 3 3 ; 4 4 TEST(TEST,ICNT) ;Process single test … … 41 41 Q MFI 42 42 SINGLE(TEST,MFICODE,MFECODE) ;Message for a single test 43 L +LR7OV0(TEST) 43 44 ;TEST= ptr to test in file 60 44 45 ;MFICODE=File Level Event Code … … 50 51 ;W !!,$P(^LAB(60,TEST,0),"^"),! I $D(ORUPDMSG(3)) ZW ORUPDMSG 51 52 I $D(ORUPDMSG(3)) S ORUPDMSG="ORUPDMSG" D MSG^XQOR("LR7O ORDERABLE OR",.ORUPDMSG) ;Send update message 53 L -LR7OV0(TEST) 52 54 Q 53 55 ADD(TEST) ;Add single record to Master file -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRAPBR1.m
r628 r636 1 1 LRAPBR1 ;DALOI/WTY/KLL;AP Browser Print Cont.;11/08/01 2 ;;5.2;LAB SERVICE;**259,317 ,363**;Sep 27, 1994;Build 32 ;;5.2;LAB SERVICE;**259,317**;Sep 27, 1994 3 3 ; 4 4 ; … … 101 101 .S X=$T(FIELDS+LRCNT) 102 102 .S LRV=$P(X,";",2),LRV1=$P(X,";",3),LRV2=$P(X,";",4) 103 .D TEXTCHK104 103 .I $P($G(^LR(LRDFN,LRSS,LRI,LRV,0)),U,4) D 105 104 ..D GLENTRY("","",1),GLENTRY(LR(69.2,LRV1),"",1) … … 252 251 ;1.1;.04;4 253 252 ;1.4;.14;5 254 TEXTCHK ; update text line counter if it is missing (Remedy 116253)255 N I,X,DATA256 S I=0257 K ^TMP("WP",$J)258 S X=$G(^LR(LRDFN,LRSS,LRI,LRV,0))259 I X'="",$L(X,"^")=1 D260 . F S I=$O(^LR(LRDFN,LRSS,LRI,LRV,I)) Q:I="" D261 . . S DATA=$G(^LR(LRDFN,LRSS,LRI,LRV,I,0))262 . . S ^TMP("WP",$J,I,0)=DATA263 I $D(^TMP("WP",$J)) D264 . D WP^DIE(63.08,LRI_","_LRDFN_",",LRV,"","^TMP(""WP"",$J)")265 . K ^TMP("WP",$J)266 Q -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSPT.m
r628 r636 1 1 LRSPT ;AVAMC/REG/WTY - AP PRELIMINARY REPORTS ;10/16/01 2 ;;5.2;LAB SERVICE;**1,72,248,259 ,373**;Sep 27, 1994;Build 12 ;;5.2;LAB SERVICE;**1,72,248,259**;Sep 27, 1994 3 3 ; 4 4 ;Reference to ^%DT supported by IA #10003 … … 67 67 K ^UTILITY($J) S DIWR=IOM-5,DIWF="W",LR("A")=0 68 68 W ! F LRZ=0:1 S LR("A")=$O(^LRO(69.2,LRAA,10,LR("A"))) Q:'LR("A") D 69 .D:$Y>(IOSL- 13) F^LRAPF,H S X=^LRO(69.2,LRAA,10,LR("A"),0) D ^DIWP69 .D:$Y>(IOSL-6) H S X=^LRO(69.2,LRAA,10,LR("A"),0) D ^DIWP 70 70 D:LRZ ^DIWW 71 71 S LRO=1 D F^LRAPF -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSRVR6.m
r628 r636 1 1 LRSRVR6 ;DALIO/JMC - LAB DATA SERVER CONT'D SNOMED EXTRACT ;Aug 17, 2006 2 ;;5.2;LAB SERVICE;**346 ,378**;Sep 27, 1994;Build 12 ;;5.2;LAB SERVICE;**346**;Sep 27, 1994;Build 10 3 3 ; Produces SNOMED extract via LRLABSERVER option 4 4 ; … … 119 119 S LRINSTR("ADDR FLAGS")="R" 120 120 S LRINSTR("FROM")="LAB_PACKAGE" 121 S LRMSUBJ=$E(LRMSUBJ,1,65)122 121 D SENDMSG^XMXAPI(.5,LRMSUBJ,"^TMP($J,""LRDATA"")",.LRTO,.LRINSTR,.LRTASK) 123 122 Q -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRVER3A.m
r628 r636 1 1 LRVER3A ;SLC/CJS/DALOI/FHS - DATA VERIFICATION ;5/27/03 14:49 2 ;;5.2;LAB SERVICE;**1,5,42,100,121,153,190,221,254,263,266,274,295 ,373**;Sep 27, 1994;Build 12 ;;5.2;LAB SERVICE;**1,5,42,100,121,153,190,221,254,263,266,274,295**;Sep 27, 1994 3 3 ;Also contains LRORFLG to restrict multiple OERR alerts (VER+2) 4 4 ; Reference to ^DIC(42 supported by IA #10039 … … 12 12 S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),(LRAOD,LRACD)=$P(^(0),U,3) 13 13 S LRACD=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,9)):^(9),1:LRACD) 14 S:' ($D(^LRO(68,LRAA,1,LRACD,1,LRAN,0))#2)LRACD=LRAD14 S:'$D(^LRO(68,LRAA,1,LRACD,1,LRAN,0))#2 LRACD=LRAD 15 15 S LRAOD=$S($D(^LRO(68,LRAA,1,LRAOD,1,LRAN,0))#2:LRAOD,1:LRAD) 16 16 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 38 ;-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 39 39 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 40 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)=LRNOW40 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 41 41 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)="" 42 42 ; Class I CareVue routine TASKED if CareVue ward - pwc/10-2000 -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRVER4.m
r628 r636 1 LRVER4 ;DALOI/CJS/DALOI/FHS - LAB ROUTINE DATA VERIFICATION ; 8/11/971 LRVER4 ;DALOI/CJS/DALOI/FHS - LAB ROUTINE DATA VERIFICATION ; 7/28/05 3:08pm 2 2 ;;5.2;LAB SERVICE;**14,42,112,121,140,171,153,188,279,283,286**;Sep 27, 1994 3 3 ; … … 10 10 . W !!,PNM," SSN: ",SSN," " S LRLCT=LRLCT+1 11 11 . 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:"??")) 12 ; 12 ; VOE Fix for an error ;RED; 7/28/05 13 I $G(SEX)="" S SEX="" 13 14 W !,"Pat Info: ",$P($G(^LR(LRDFN,.091)),U) 14 15 W ?34," Sex: ",$S(SEX="M":"MALE",SEX="F":"FEMALE",1:SEX) -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRWLST1.m
r628 r636 1 1 LRWLST1 ;DALOI/CJS/RWF/FHS - ACCESSION SETUP ; July 19, 2006 2 ;;5.2;LAB SERVICE;**48,65,121,153,261,286,331 ,379**;Sep 27, 1994;Build 22 ;;5.2;LAB SERVICE;**48,65,121,153,261,286,331**;Sep 27, 1994;Build 7 3 3 ; 4 4 ; Reference to ^DIC(42 supported by IA #10039 … … 99 99 . S FDA(2,68.05,"+1,"_LR6802,.01)=LRSPEC 100 100 . S FDA(2,68.05,"+1,"_LR6802,1)=$P(LRSAMP,";",1) 101 . ; 102 . ; Modification to prevent lock failures - loop 10 times to give system a chance to get lock 103 . N LRLOCKOK,LRLOOPCT 104 . S LRLOCKOK=0 105 . F LRLOOPCT=1:1:10 Q:LRLOCKOK D I 'LRLOCKOK H 5 106 . . K LRDIE(2) 107 . . D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)") 108 . . S:$D(LRDIE(2))=0 LRLOCKOK=1 109 . K LRLOCKOK,LRLOOPCT 110 . ; 111 . ;D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)") 101 . D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)") 112 102 . I $D(LRDIE(2)) D MAILALRT 113 103 ; … … 287 277 S FDAIEN(1)=LRAN 288 278 S FDA(2,68.02,"+1,"_LR6802,.01)=LRDFN 289 ; 290 ; Modification to prevent lock failures - loop 10 times to give system a chance to get lock 291 N LRLOCKOK,LRLOOPCT 292 S LRLOCKOK=0 293 F LRLOOPCT=1:1:10 Q:LRLOCKOK D I 'LRLOCKOK H 5 294 . K LRDIE(2) 295 . D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)") 296 . S:$D(LRDIE(2))=0 LRLOCKOK=1 297 K LRLOCKOK,LRLOOPCT 298 ; 299 ;D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)") 279 D UPDATE^DIE("","FDA(2)","FDAIEN","LRDIE(2)") 300 280 I $D(LRDIE(2)) D MAILALRT 301 281 Q -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRWLST11.m
r628 r636 1 1 LRWLST11 ;DALOI/CJS,RWF/FHS - ACCESSION SETUP ;July 19, 2006 2 ;;5.2;LAB SERVICE;**121,128,153,202,286,331 ,375**;Sep 27, 1994;Build 32 ;;5.2;LAB SERVICE;**121,128,153,202,286,331**;Sep 27, 1994;Build 7 3 3 ; 4 4 ST21 ; … … 12 12 ; when tests are acessioned to the 'in common' area. 13 13 I +LRWLC,+LRWLC'=+LRAA,$G(^LRO(68,LRWLC,1,LRAD,1,LRAN,0))=$G(LRDFN) D 14 . I 'LRUNQ,$D(LRTSTS(LRWLC,LRUNQ,LRWLC)) Q14 . I $D(LRTSTS(LRWLC,LRUNQ,LRWLC)) Q 15 15 . Q:$G(^LRO(68,LRWLC,1,LRAD,1,LRAN,.1)) 16 16 . N LRAA,LRACC,LRCDTX,LRCOMMON,LREND,LRIDT,LRNODE3,LRORDRR,LRORU3,LRQUIET,LRTJ,LRUID,X,Y -
FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRX.m
r628 r636 1 LRX ;SLC/BA/DALISC/FHS - UTILITY ROUTINES -- PREVIOUSLY ^LAB("X","...") ; 2/8/91 07:302 ;;5.2;LAB SERVICE;**65,153,201,217,290,360 **;Sep 27, 1994;Build 11 LRX ;SLC/BA/DALISC/FHS - UTILITY ROUTINES -- PREVIOUSLY ^LAB("X","...") ;1/26/07 18:36 2 ;;5.2;LAB SERVICE;**65,153,201,217,290,360,350**;Sep 27, 1994;Build 10 3 3 PT ;patient info 4 4 ; … … 23 23 . . S SEX=$P(VADM(5),U),DOB=$P(VADM(3),U),DOD=$P(VADM(6),U) 24 24 . . S AGE=VADM(4),AGE(2)=$$AGE2(DOB,$G(LRCDT)) 25 . . S SSN=$P(VADM(2),U),LRWRD=$P(VAIN(4),U,2) 25 . . ; S SSN=$P(VADM(2),U),LRWRD=$P(VAIN(4),U,2) 26 . . S SSN=VA("PID"),LRWRD=$P(VAIN(4),U,2) ; for VOE 26 27 . . S LRWRD(1)=+VAIN(4),LRRB=VAIN(5),LRPRAC=+VAIN(2) 27 28 . . S:VAIN(3) LRTREA=+VAIN(3) … … 43 44 . D DEM^VADPT D:'VAERR 44 45 . . S PNM=VADM(1),SEX=$P(VADM(5),U) 45 . . S DOB=$P(VADM(3),U),SSN=$P(VADM(2),U) 46 . . ; S DOB=$P(VADM(3),U),SSN=$P(VADM(2),U) 47 . . S DOB=$P(VADM(3),U),SSN=VA("PID") ; for VOE 46 48 . . S AGE=VADM(4),AGE(2)=$$AGE2(DOB,$G(LRCDT)) 47 49 D SSNFM^LRU
Note:
See TracChangeset
for help on using the changeset viewer.
