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