source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRPX.m@ 1432

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1LRPX ;SLC/STAFF - Process lab indexes ;9/26/03 15:39
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3 ;
4 ;
5CHKILL(LRDFN,LRIDT) ; from LROC
6 ; delete Chem xrefs in ^PXRMINDX(63
7 N DAS,DATE,DFN,LRDN,OK,TEST
8 I '$L($G(^LR(+$G(LRDFN),"CH",+$G(LRIDT),0))) Q
9 D PATIENT(LRDFN,.DFN,.OK) I 'OK Q
10 S DATE=9999999-LRIDT
11 S LRDN=1
12 F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
13 . D TESTS(LRDFN,LRIDT,LRDN,.TEST)
14 . S DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
15 . D KLAB(DFN,DATE,TEST,DAS)
16 . ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
17 Q
18 ;
19CHSET(LRDFN,LRIDT) ; from LRVER3A
20 ; add Chem xrefs in ^PXRMINDX(63
21 N DAS,DATE,DFN,LRDN,OK,TEST
22 I '$P($G(^LR(+$G(LRDFN),"CH",+$G(LRIDT),0)),U,3) Q
23 D PATIENT(LRDFN,.DFN,.OK) I 'OK Q
24 S DATE=9999999-LRIDT
25 S LRDN=1
26 F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
27 . D TESTS(LRDFN,LRIDT,LRDN,.TEST)
28 . S DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
29 . D SLAB(DFN,DATE,TEST,DAS)
30 . ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
31 Q
32 ;
33PATIENT(LRDFN,DFN,OK) ;
34 N ZERO
35 S OK=1
36 I '$G(LRDFN) S OK=0 Q
37 S ZERO=$G(^LR(LRDFN,0))
38 I $P(ZERO,U,2)'=2 S OK=0 Q
39 S DFN=+$P(ZERO,U,3)
40 I LRDFN'=$$LRDFN^LRPXAPIU(DFN) S OK=0
41 Q
42 ;
43TESTS(LRDFN,LRIDT,LRDN,TEST) ;
44 N DATA
45 S DATA=^LR(LRDFN,"CH",LRIDT,LRDN)
46 S TEST=+$P($P(DATA,U,3),"!",6)
47 I 'TEST S TEST=+$O(^LAB(60,"C","CH;"_LRDN_";1",0))
48 Q
49 ;
50 ; ------------- Lab Use Only ------------
51 ;
52KLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM
53 ; delete index for lab data.
54 K ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE) ; dbia 4114
55 K ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE) ; dbia 4114
56 I ITEM=+ITEM Q
57 K ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE) ; dbia 4114
58 Q
59 ;
60SLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM, LRPXSXRA, LRPXSXRB, LRPXSXRL
61 ; set index for lab data.
62 S ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)="" ; dbia 4114
63 S ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)="" ; dbia 4114
64 I ITEM=+ITEM Q
65 S ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)="" ; dbia 4114
66 Q
67 ;
Note: See TracBrowser for help on using the repository browser.