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