LRPX ;SLC/STAFF - Process lab indexes ;9/26/03 15:39
;;5.2;LAB SERVICE;**295,445**;Sep 27, 1994;Build 6
;
;
CHKILL(LRDFN,LRIDT) ; from LROC
; delete Chem xrefs in ^PXRMINDX(63
N DAS,DATE,DFN,LRDN,OK,TEST
I '$L($G(^LR(+$G(LRDFN),"CH",+$G(LRIDT),0))) Q
D PATIENT(LRDFN,.DFN,.OK) I 'OK Q
S DATE=9999999-LRIDT
S LRDN=1
F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
. D TESTS(LRDFN,LRIDT,LRDN,.TEST)
. S DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
. D KLAB(DFN,DATE,TEST,DAS)
. ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
Q
;
CHSET(LRDFN,LRIDT) ; from LRVER3A
; add Chem xrefs in ^PXRMINDX(63
N DAS,DATE,DFN,LRDN,OK,TEST
I '$P($G(^LR(+$G(LRDFN),"CH",+$G(LRIDT),0)),U,3) Q
D PATIENT(LRDFN,.DFN,.OK) I 'OK Q
S DATE=9999999-LRIDT
S LRDN=1
F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 D
. D TESTS(LRDFN,LRIDT,LRDN,.TEST)
. S DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
. D SLAB(DFN,DATE,TEST,DAS)
. ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
Q
;
PATIENT(LRDFN,DFN,OK) ;
N ZERO
S OK=1
I '$G(LRDFN) S OK=0 Q
S ZERO=$G(^LR(LRDFN,0))
I $P(ZERO,U,2)'=2 S OK=0 Q
S DFN=+$P(ZERO,U,3)
I LRDFN'=$$LRDFN^LRPXAPIU(DFN) S OK=0
Q
;
TESTS(LRDFN,LRIDT,LRDN,TEST) ;
N DATA
S DATA=^LR(LRDFN,"CH",LRIDT,LRDN)
S TEST=+$P($P(DATA,U,3),"!",7)
I 'TEST S TEST=+$O(^LAB(60,"C","CH;"_LRDN_";1",0))
Q
;
; ------------- Lab Use Only ------------
;
KLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM
; delete index for lab data.
K ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE) ; dbia 4114
K ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE) ; dbia 4114
I ITEM=+ITEM Q
K ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE) ; dbia 4114
Q
;
SLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM, LRPXSXRA, LRPXSXRB, LRPXSXRL
; set index for lab data.
S ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)="" ; dbia 4114
S ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)="" ; dbia 4114
I ITEM=+ITEM Q
S ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)="" ; dbia 4114
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPX 1980 printed Dec 13, 2024@02:19:27 Page 2
LRPX ;SLC/STAFF - Process lab indexes ;9/26/03 15:39
+1 ;;5.2;LAB SERVICE;**295,445**;Sep 27, 1994;Build 6
+2 ;
+3 ;
CHKILL(LRDFN,LRIDT) ; from LROC
+1 ; delete Chem xrefs in ^PXRMINDX(63
+2 NEW DAS,DATE,DFN,LRDN,OK,TEST
+3 IF '$LENGTH($GET(^LR(+$GET(LRDFN),"CH",+$GET(LRIDT),0)))
QUIT
+4 DO PATIENT(LRDFN,.DFN,.OK)
IF 'OK
QUIT
+5 SET DATE=9999999-LRIDT
+6 SET LRDN=1
+7 FOR
SET LRDN=$ORDER(^LR(LRDFN,"CH",LRIDT,LRDN))
if LRDN<1
QUIT
Begin DoDot:1
+8 DO TESTS(LRDFN,LRIDT,LRDN,.TEST)
+9 SET DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
+10 DO KLAB(DFN,DATE,TEST,DAS)
+11 ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
End DoDot:1
+12 QUIT
+13 ;
CHSET(LRDFN,LRIDT) ; from LRVER3A
+1 ; add Chem xrefs in ^PXRMINDX(63
+2 NEW DAS,DATE,DFN,LRDN,OK,TEST
+3 IF '$PIECE($GET(^LR(+$GET(LRDFN),"CH",+$GET(LRIDT),0)),U,3)
QUIT
+4 DO PATIENT(LRDFN,.DFN,.OK)
IF 'OK
QUIT
+5 SET DATE=9999999-LRIDT
+6 SET LRDN=1
+7 FOR
SET LRDN=$ORDER(^LR(LRDFN,"CH",LRIDT,LRDN))
if LRDN<1
QUIT
Begin DoDot:1
+8 DO TESTS(LRDFN,LRIDT,LRDN,.TEST)
+9 SET DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
+10 DO SLAB(DFN,DATE,TEST,DAS)
+11 ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
End DoDot:1
+12 QUIT
+13 ;
PATIENT(LRDFN,DFN,OK) ;
+1 NEW ZERO
+2 SET OK=1
+3 IF '$GET(LRDFN)
SET OK=0
QUIT
+4 SET ZERO=$GET(^LR(LRDFN,0))
+5 IF $PIECE(ZERO,U,2)'=2
SET OK=0
QUIT
+6 SET DFN=+$PIECE(ZERO,U,3)
+7 IF LRDFN'=$$LRDFN^LRPXAPIU(DFN)
SET OK=0
+8 QUIT
+9 ;
TESTS(LRDFN,LRIDT,LRDN,TEST) ;
+1 NEW DATA
+2 SET DATA=^LR(LRDFN,"CH",LRIDT,LRDN)
+3 SET TEST=+$PIECE($PIECE(DATA,U,3),"!",7)
+4 IF 'TEST
SET TEST=+$ORDER(^LAB(60,"C","CH;"_LRDN_";1",0))
+5 QUIT
+6 ;
+7 ; ------------- Lab Use Only ------------
+8 ;
KLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM
+1 ; delete index for lab data.
+2 ; dbia 4114
KILL ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)
+3 ; dbia 4114
KILL ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)
+4 IF ITEM=+ITEM
QUIT
+5 ; dbia 4114
KILL ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)
+6 QUIT
+7 ;
SLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM, LRPXSXRA, LRPXSXRB, LRPXSXRL
+1 ; set index for lab data.
+2 ; dbia 4114
SET ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)=""
+3 ; dbia 4114
SET ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)=""
+4 IF ITEM=+ITEM
QUIT
+5 ; dbia 4114
SET ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)=""
+6 QUIT
+7 ;
