Routine: LRPX

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 ***

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 ***

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

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))

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

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

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      ;

LRPX.m