1 | LRPX ;SLC/STAFF - Process lab indexes ;9/26/03 15:39
|
---|
2 | ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
|
---|
3 | ;
|
---|
4 | ;
|
---|
5 | CHKILL(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 | ;
|
---|
19 | CHSET(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 | ;
|
---|
33 | PATIENT(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 | ;
|
---|
43 | TESTS(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 | ;
|
---|
52 | KLAB(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 | ;
|
---|
60 | SLAB(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 | ;
|
---|