| 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 |  ;
 | 
|---|