[613] | 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 | ;
|
---|