Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRPX

LRPX.m

Go to the documentation of this file.
  1. LRPX ;SLC/STAFF - Process lab indexes ;9/26/03 15:39
  1. ;;5.2;LAB SERVICE;**295,445**;Sep 27, 1994;Build 6
  1. ;
  1. ;
  1. CHKILL(LRDFN,LRIDT) ; from LROC
  1. ; delete Chem xrefs in ^PXRMINDX(63
  1. N DAS,DATE,DFN,LRDN,OK,TEST
  1. I '$L($G(^LR(+$G(LRDFN),"CH",+$G(LRIDT),0))) Q
  1. D PATIENT(LRDFN,.DFN,.OK) I 'OK Q
  1. S DATE=9999999-LRIDT
  1. S LRDN=1
  1. F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
  1. . D TESTS(LRDFN,LRIDT,LRDN,.TEST)
  1. . S DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
  1. . D KLAB(DFN,DATE,TEST,DAS)
  1. . ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
  1. Q
  1. ;
  1. CHSET(LRDFN,LRIDT) ; from LRVER3A
  1. ; add Chem xrefs in ^PXRMINDX(63
  1. N DAS,DATE,DFN,LRDN,OK,TEST
  1. I '$P($G(^LR(+$G(LRDFN),"CH",+$G(LRIDT),0)),U,3) Q
  1. D PATIENT(LRDFN,.DFN,.OK) I 'OK Q
  1. S DATE=9999999-LRIDT
  1. S LRDN=1
  1. F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
  1. . D TESTS(LRDFN,LRIDT,LRDN,.TEST)
  1. . S DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
  1. . D SLAB(DFN,DATE,TEST,DAS)
  1. . ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
  1. Q
  1. ;
  1. PATIENT(LRDFN,DFN,OK) ;
  1. N ZERO
  1. S OK=1
  1. I '$G(LRDFN) S OK=0 Q
  1. S ZERO=$G(^LR(LRDFN,0))
  1. I $P(ZERO,U,2)'=2 S OK=0 Q
  1. S DFN=+$P(ZERO,U,3)
  1. I LRDFN'=$$LRDFN^LRPXAPIU(DFN) S OK=0
  1. Q
  1. ;
  1. TESTS(LRDFN,LRIDT,LRDN,TEST) ;
  1. N DATA
  1. S DATA=^LR(LRDFN,"CH",LRIDT,LRDN)
  1. S TEST=+$P($P(DATA,U,3),"!",7)
  1. I 'TEST S TEST=+$O(^LAB(60,"C","CH;"_LRDN_";1",0))
  1. Q
  1. ;
  1. ; ------------- Lab Use Only ------------
  1. ;
  1. KLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM
  1. ; delete index for lab data.
  1. K ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE) ; dbia 4114
  1. K ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE) ; dbia 4114
  1. I ITEM=+ITEM Q
  1. K ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE) ; dbia 4114
  1. Q
  1. ;
  1. SLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM, LRPXSXRA, LRPXSXRB, LRPXSXRL
  1. ; set index for lab data.
  1. S ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)="" ; dbia 4114
  1. S ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)="" ; dbia 4114
  1. I ITEM=+ITEM Q
  1. S ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)="" ; dbia 4114
  1. Q
  1. ;