BLRALUT1 ;DAOU/ALA-Lab ES Utility
;;5.2T9;LR;**1018**;Nov 17, 2004
;;5.2;LR;**1013,1015**;Nov 18, 2002
;
;**Program Description**
; This contains utilities for Lab Audit
;
SX ;EP
; Set review cross-reference
; ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN)
; BLRARPHY = Responsible Physician
; BLRARFL = Review Status
; 0 = Not Reviewed
; 1 = Reviewed, not signed
; 2 = Reviewed, signed
; LRIDT = Reverse Date
; LRDFN = Lab Patient
;
I $G(BLRARPHY)=""!($G(BLRARFL)="")!($G(LRIDT)="")!($G(LRDFN)="") Q
;
;S ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN)=LRSS
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
S ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN,LRSS)=LRSS
;----- END IHS MODIFICATIONS
Q
;
KX ;EP
; Kill review cross-reference
; ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN)
; BLRARPHY = Responsible Physician
; BLRARFL = Review Status
; LRIDT = Reverse Date
; LRDFN = Lab Patient
;
I $G(BLRARPHY)=""!($G(BLRARFL)="")!($G(LRIDT)="")!($G(LRDFN)="") Q
;
;K ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN)
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
K ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN,LRSS)
;----- END IHS MODIFICATIONS
Q
;
ALT ; Generate alert message
;
; If user is not found in the participating physician file
; then they are not participating in the Electronic signature
; modification.
I '$D(^BLRALAB(9009027.1,DUZ)) Q
;
; If user is an inactive participating physician, alert not shown
I $P($G(^BLRALAB(9009027.1,DUZ,0)),U,7)="I" Q
;
; Variables
; BLRABC = Abnormal Count
; BLRANC = Normal Count
; BLRCRC = Critical Count
; DUZ = User
S BLRABC=0,BLRANC=0,BLRCRC=0,BLRADUZ=DUZ D FND
;
; Check for surrogates
S BLRADUZ=""
F S BLRADUZ=$O(^BLRALAB(9009027.1,"AB",DUZ,BLRADUZ)) Q:BLRADUZ="" D
. S BSTDT=$P($G(^BLRALAB(9009027.1,BLRADUZ,1,DUZ,0)),U,2)
. S BENDT=$P($G(^BLRALAB(9009027.1,BLRADUZ,1,DUZ,0)),U,3)
. I BENDT=""!(BSTDT="") Q
. I DT'<BSTDT&(DT'>BENDT) D FND
;
I BLRANC'=0 D
. W !!?5,"You have "_BLRANC_" Lab Results to Review" S BX=""
I BLRCRC'=0 D
. W !,?10," with "_BLRCRC_" CRITICAL"_$S(BLRCRC=1:"",1:"s")
. S BX=" and"
I BLRABC'=0 D
. I BLRCRC=0 W !,?10
. W BX_" with "_BLRABC_" ABNORMAL"_$S(BLRABC=1:"",1:"s")
Q
;
FND ; Find results
S BLRAS=""
F S BLRAS=$O(^LR("BLRA",BLRADUZ,BLRAS)) Q:BLRAS=2!(BLRAS="") D
. S BLRVD=""
. F S BLRVD=$O(^LR("BLRA",BLRADUZ,BLRAS,BLRVD)) Q:BLRVD="" D
.. S BLRAP=""
.. F S BLRAP=$O(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP)) Q:BLRAP="" D
... ;S BLRIDT=$P(BLRVD,"-",2),BLRSS=$G(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP))
... ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
... S BLRSS=""
... F S BLRSS=$O(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP,BLRSS)) Q:BLRSS="" D
.... S BLRIDT=$P(BLRVD,"-",2)
.... ;----- END IHS MODIFICATIONS
.... S BLRANC=BLRANC+1
.... I +$P($G(^LR(BLRAP,BLRSS,BLRIDT,9009027)),U,8)'=0 S BLRCRC=BLRCRC+1 Q
.... I $P($G(^LR(BLRAP,BLRSS,BLRIDT,9009027)),U,6)'=0 S BLRABC=BLRABC+1
Q
HEAD ; Privacy warning message
W @IOF
F BLRAJ=0:1:3 D H1
Q
;
H1 S BLRAX=$T(TEXT+BLRAJ),BLRAX=$P(BLRAX,";;",2)
W !?80-$L(BLRAX)\2,BLRAX
Q
TEXT ;;WARNING: RESTRICTED GOVERNMENT PATIENT DATA, UNAUTHORIZED
;;ENTRY INTO THIS SYSTEM OR USE OF THIS DATA IS A FEDERAL CRIME
;;****************************************************
BLRALUT1 ;DAOU/ALA-Lab ES Utility
+1 ;;5.2T9;LR;**1018**;Nov 17, 2004
+2 ;;5.2;LR;**1013,1015**;Nov 18, 2002
+3 ;
+4 ;**Program Description**
+5 ; This contains utilities for Lab Audit
+6 ;
SX ;EP
+1 ; Set review cross-reference
+2 ; ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN)
+3 ; BLRARPHY = Responsible Physician
+4 ; BLRARFL = Review Status
+5 ; 0 = Not Reviewed
+6 ; 1 = Reviewed, not signed
+7 ; 2 = Reviewed, signed
+8 ; LRIDT = Reverse Date
+9 ; LRDFN = Lab Patient
+10 ;
+11 IF $GET(BLRARPHY)=""!($GET(BLRARFL)="")!($GET(LRIDT)="")!($GET(LRDFN)="")
QUIT
+12 ;
+13 ;S ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN)=LRSS
+14 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+15 SET ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN,LRSS)=LRSS
+16 ;----- END IHS MODIFICATIONS
+17 QUIT
+18 ;
KX ;EP
+1 ; Kill review cross-reference
+2 ; ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN)
+3 ; BLRARPHY = Responsible Physician
+4 ; BLRARFL = Review Status
+5 ; LRIDT = Reverse Date
+6 ; LRDFN = Lab Patient
+7 ;
+8 IF $GET(BLRARPHY)=""!($GET(BLRARFL)="")!($GET(LRIDT)="")!($GET(LRDFN)="")
QUIT
+9 ;
+10 ;K ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN)
+11 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+12 KILL ^LR("BLRA",BLRARPHY,BLRARFL,-LRIDT,LRDFN,LRSS)
+13 ;----- END IHS MODIFICATIONS
+14 QUIT
+15 ;
ALT ; Generate alert message
+1 ;
+2 ; If user is not found in the participating physician file
+3 ; then they are not participating in the Electronic signature
+4 ; modification.
+5 IF '$DATA(^BLRALAB(9009027.1,DUZ))
QUIT
+6 ;
+7 ; If user is an inactive participating physician, alert not shown
+8 IF $PIECE($GET(^BLRALAB(9009027.1,DUZ,0)),U,7)="I"
QUIT
+9 ;
+10 ; Variables
+11 ; BLRABC = Abnormal Count
+12 ; BLRANC = Normal Count
+13 ; BLRCRC = Critical Count
+14 ; DUZ = User
+15 SET BLRABC=0
SET BLRANC=0
SET BLRCRC=0
SET BLRADUZ=DUZ
DO FND
+16 ;
+17 ; Check for surrogates
+18 SET BLRADUZ=""
+19 FOR
SET BLRADUZ=$ORDER(^BLRALAB(9009027.1,"AB",DUZ,BLRADUZ))
IF BLRADUZ=""
QUIT
Begin DoDot:1
+20 SET BSTDT=$PIECE($GET(^BLRALAB(9009027.1,BLRADUZ,1,DUZ,0)),U,2)
+21 SET BENDT=$PIECE($GET(^BLRALAB(9009027.1,BLRADUZ,1,DUZ,0)),U,3)
+22 IF BENDT=""!(BSTDT="")
QUIT
+23 IF DT'<BSTDT&(DT'>BENDT)
DO FND
End DoDot:1
+24 ;
+25 IF BLRANC'=0
Begin DoDot:1
+26 WRITE !!?5,"You have "_BLRANC_" Lab Results to Review"
SET BX=""
End DoDot:1
+27 IF BLRCRC'=0
Begin DoDot:1
+28 WRITE !,?10," with "_BLRCRC_" CRITICAL"_$SELECT(BLRCRC=1:"",1:"s")
+29 SET BX=" and"
End DoDot:1
+30 IF BLRABC'=0
Begin DoDot:1
+31 IF BLRCRC=0
WRITE !,?10
+32 WRITE BX_" with "_BLRABC_" ABNORMAL"_$SELECT(BLRABC=1:"",1:"s")
End DoDot:1
+33 QUIT
+34 ;
FND ; Find results
+1 SET BLRAS=""
+2 FOR
SET BLRAS=$ORDER(^LR("BLRA",BLRADUZ,BLRAS))
IF BLRAS=2!(BLRAS="")
QUIT
Begin DoDot:1
+3 SET BLRVD=""
+4 FOR
SET BLRVD=$ORDER(^LR("BLRA",BLRADUZ,BLRAS,BLRVD))
IF BLRVD=""
QUIT
Begin DoDot:2
+5 SET BLRAP=""
+6 FOR
SET BLRAP=$ORDER(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP))
IF BLRAP=""
QUIT
Begin DoDot:3
+7 ;S BLRIDT=$P(BLRVD,"-",2),BLRSS=$G(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP))
+8 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+9 SET BLRSS=""
+10 FOR
SET BLRSS=$ORDER(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP,BLRSS))
IF BLRSS=""
QUIT
Begin DoDot:4
+11 SET BLRIDT=$PIECE(BLRVD,"-",2)
+12 ;----- END IHS MODIFICATIONS
+13 SET BLRANC=BLRANC+1
+14 IF +$PIECE($GET(^LR(BLRAP,BLRSS,BLRIDT,9009027)),U,8)'=0
SET BLRCRC=BLRCRC+1
QUIT
+15 IF $PIECE($GET(^LR(BLRAP,BLRSS,BLRIDT,9009027)),U,6)'=0
SET BLRABC=BLRABC+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
HEAD ; Privacy warning message
+1 WRITE @IOF
+2 FOR BLRAJ=0:1:3
DO H1
+3 QUIT
+4 ;
H1 SET BLRAX=$TEXT(TEXT+BLRAJ)
SET BLRAX=$PIECE(BLRAX,";;",2)
+1 WRITE !?80-$LENGTH(BLRAX)\2,BLRAX
+2 QUIT
TEXT ;;WARNING: RESTRICTED GOVERNMENT PATIENT DATA, UNAUTHORIZED
+1 ;;ENTRY INTO THIS SYSTEM OR USE OF THIS DATA IS A FEDERAL CRIME
+2 ;;****************************************************
