- 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 Jan 18, 2025@03:20:09 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 ;