LRPX ;VA/SLC/STAFF - Process lab indexes ; 22-Oct-2013 09:22 ; MKK
;;5.2;LAB SERVICE;**295,1030,1031,1033**;NOV 01, 1997
;
CHKILL(LRDFN,LRIDT) ; from LROC
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; RPMS Lab does not use Clinical Reminders.
; None of the following code will be used.
; Q
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
Q:'$$PATCH^BLRUTIL4("PXRM*1.5*12") ; IHS/MSC/MKK - LR*5.2*1031
;
;
; 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
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; RPMS Lab does not use Clinical Reminders.
; None of the following code will be used.
; Q
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
Q:'$$PATCH^BLRUTIL4("PXRM*1.5*12") ; IHS/MSC/MKK - LR*5.2*1031
;
; 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) ;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; RPMS Lab does not use Clinical Reminders.
; None of the following code will be used.
; Q
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
Q:'$$PATCH^BLRUTIL4("PXRM*1.5*12") ; IHS/MSC/MKK - LR*5.2*1031
;
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) ;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; RPMS Lab does not use Clinical Reminders.
; None of the following code will be used.
; Q
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
Q:'$$PATCH^BLRUTIL4("PXRM*1.5*12") ; IHS/MSC/MKK - LR*5.2*1031
;
N DATA
; S DATA=^LR(LRDFN,"CH",LRIDT,LRDN)
S DATA=$G(^LR(LRDFN,"CH",LRIDT,LRDN)) ; IHS/MSC/MKK - LR*5.2*1033
S TEST=+$P($P(DATA,U,3),"!",6)
I 'TEST S TEST=+$O(^LAB(60,"C","CH;"_LRDN_";1",0))
Q
;
; ------------- Lab Use Only ------------
;
KLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; RPMS Lab does not use Clinical Reminders.
; None of the following code will be used.
; Q
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
Q:'$$PATCH^BLRUTIL4("PXRM*1.5*12") ; IHS/MSC/MKK - LR*5.2*1031
;
; 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
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; RPMS Lab does not use Clinical Reminders.
; None of the following code will be used.
; Q
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
Q:'$$PATCH^BLRUTIL4("PXRM*1.5*12") ; IHS/MSC/MKK - LR*5.2*1031
;
; 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
;
LRPX ;VA/SLC/STAFF - Process lab indexes ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**295,1030,1031,1033**;NOV 01, 1997
+2 ;
CHKILL(LRDFN,LRIDT) ; from LROC
+1 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+2 ; RPMS Lab does not use Clinical Reminders.
+3 ; None of the following code will be used.
+4 ; Q
+5 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+6 ;
+7 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
QUIT
+8 ;
+9 ;
+10 ; delete Chem xrefs in ^PXRMINDX(63
+11 NEW DAS,DATE,DFN,LRDN,OK,TEST
+12 IF '$LENGTH($GET(^LR(+$GET(LRDFN),"CH",+$GET(LRIDT),0)))
QUIT
+13 DO PATIENT(LRDFN,.DFN,.OK)
IF 'OK
QUIT
+14 SET DATE=9999999-LRIDT
+15 SET LRDN=1
+16 FOR
SET LRDN=$ORDER(^LR(LRDFN,"CH",LRIDT,LRDN))
IF LRDN<1
QUIT
Begin DoDot:1
+17 DO TESTS(LRDFN,LRIDT,LRDN,.TEST)
+18 SET DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
+19 DO KLAB(DFN,DATE,TEST,DAS)
+20 ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
End DoDot:1
+21 QUIT
+22 ;
CHSET(LRDFN,LRIDT) ; from LRVER3A
+1 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+2 ; RPMS Lab does not use Clinical Reminders.
+3 ; None of the following code will be used.
+4 ; Q
+5 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+6 ;
+7 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
QUIT
+8 ;
+9 ; add Chem xrefs in ^PXRMINDX(63
+10 NEW DAS,DATE,DFN,LRDN,OK,TEST
+11 IF '$PIECE($GET(^LR(+$GET(LRDFN),"CH",+$GET(LRIDT),0)),U,3)
QUIT
+12 DO PATIENT(LRDFN,.DFN,.OK)
IF 'OK
QUIT
+13 SET DATE=9999999-LRIDT
+14 SET LRDN=1
+15 FOR
SET LRDN=$ORDER(^LR(LRDFN,"CH",LRIDT,LRDN))
IF LRDN<1
QUIT
Begin DoDot:1
+16 DO TESTS(LRDFN,LRIDT,LRDN,.TEST)
+17 SET DAS=LRDFN_";CH;"_LRIDT_";"_LRDN
+18 DO SLAB(DFN,DATE,TEST,DAS)
+19 ; D TIMESTMP^LRLOG(DFN,"CH",DATE,DUZ) *** future use ***
End DoDot:1
+20 QUIT
+21 ;
PATIENT(LRDFN,DFN,OK) ;
+1 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+2 ; RPMS Lab does not use Clinical Reminders.
+3 ; None of the following code will be used.
+4 ; Q
+5 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+6 ;
+7 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
QUIT
+8 ;
+9 NEW ZERO
+10 SET OK=1
+11 IF '$GET(LRDFN)
SET OK=0
QUIT
+12 SET ZERO=$GET(^LR(LRDFN,0))
+13 IF $PIECE(ZERO,U,2)'=2
SET OK=0
QUIT
+14 SET DFN=+$PIECE(ZERO,U,3)
+15 IF LRDFN'=$$LRDFN^LRPXAPIU(DFN)
SET OK=0
+16 QUIT
+17 ;
TESTS(LRDFN,LRIDT,LRDN,TEST) ;
+1 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+2 ; RPMS Lab does not use Clinical Reminders.
+3 ; None of the following code will be used.
+4 ; Q
+5 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+6 ;
+7 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
QUIT
+8 ;
+9 NEW DATA
+10 ; S DATA=^LR(LRDFN,"CH",LRIDT,LRDN)
+11 ; IHS/MSC/MKK - LR*5.2*1033
SET DATA=$GET(^LR(LRDFN,"CH",LRIDT,LRDN))
+12 SET TEST=+$PIECE($PIECE(DATA,U,3),"!",6)
+13 IF 'TEST
SET TEST=+$ORDER(^LAB(60,"C","CH;"_LRDN_";1",0))
+14 QUIT
+15 ;
+16 ; ------------- Lab Use Only ------------
+17 ;
KLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM
+1 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+2 ; RPMS Lab does not use Clinical Reminders.
+3 ; None of the following code will be used.
+4 ; Q
+5 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+6 ;
+7 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
QUIT
+8 ;
+9 ; delete index for lab data.
+10 ; dbia 4114
KILL ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)
+11 ; dbia 4114
KILL ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)
+12 IF ITEM=+ITEM
QUIT
+13 ; dbia 4114
KILL ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)
+14 QUIT
+15 ;
SLAB(DFN,DATE,ITEM,NODE) ; from LRPXRM, LRPXSXRA, LRPXSXRB, LRPXSXRL
+1 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+2 ; RPMS Lab does not use Clinical Reminders.
+3 ; None of the following code will be used.
+4 ; Q
+5 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+6 ;
+7 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
QUIT
+8 ;
+9 ; set index for lab data.
+10 ; dbia 4114
SET ^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)=""
+11 ; dbia 4114
SET ^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)=""
+12 IF ITEM=+ITEM
QUIT
+13 ; dbia 4114
SET ^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)=""
+14 QUIT
+15 ;
