BLRALFN1 ;DAOU/ALA-Lab ES Functions [ 11/18/2002 1:36 PM ]
;;5.2;LR;**1013,1015**;NOV 18, 2002
;
;**Program Description**
; This program contains three functions for the Lab
; Electronic Signature modification; SIGN, REVIEW, and
; UNSIGN.
;
SIGN ; Physician is signing
;I VALMLST<VALMCNT S VALMSG="YOU MUST SIGN ON THE LAST PAGE" D RE^VALM4 Q ; FIX #46
I VALMLST<VALMCNT D
. W !!,"**WARNING! You must sign on the last page.**"
. N DIR,X,Y
. S DIR(0)="E",DIR("T")=10,DIR("A")="Press return to continue " D ^DIR
. I Y>0 S BLRASFL=1 D RE^VALM4 Q
;
; Set the date/time signed to the current date/time
S BLRASDTM=$$NOW^XLFDT()
S BLRADATA=$G(^LR(LRDFN,LRSS,LRIDT,9009027))
;
; Kill off the old cross-reference and set new one
S BLRARPHY=$P(BLRADATA,U,2),BLRARFL=$P(BLRADATA,U,1)
;
; Check for pending results flag
S BLRAPND=+$P(BLRADATA,U,7)
I BLRAPND D EN^DDIOL("You cannot sign for a result with pending results","","!!") Q
;
D KX^BLRALUT1
;
; Set result flag to 'Reviewed, signed'
S BLRARFL=$S($G(BLRASFL)'="":BLRASFL,1:2)
D SX^BLRALUT1
;
S $P(BLRADATA,U,1)=BLRARFL,$P(BLRADATA,U,3)=DUZ,$P(BLRADATA,U,5)=BLRASDTM
;
S ^LR(LRDFN,LRSS,LRIDT,9009027)=BLRADATA
;
K BLRADATA,BLRARPHY,BLRARFL,BLRASDTM,BLRAPND,BLRASFL
;
Q
;
REVW ;EP
; Physician is reviewing only
; Set audit for review
I $G(DFN)="" S DFN=$P($G(^LR(LRDFN,0)),U,3)
S BLRAACN=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),U,6)
D ^BLRALAU
;
; Set the date/time reviewed to the current date/time
S BLRARDTM=$$NOW^XLFDT()
S BLRADATA=$G(^LR(LRDFN,LRSS,LRIDT,9009027))
;
; Kill off the old cross-reference and set new one
S BLRARPHY=$P(BLRADATA,U,2),BLRARFL=$P(BLRADATA,U,1)
;
; If already signed, quit
I BLRARFL=2 K BLRARDTM,BLRADATA,BLRARPHY,BLRARFL Q
D KX^BLRALUT1
;
; Set result flag to 'Reviewed, not signed'
S BLRARFL=1
D SX^BLRALUT1
;
; Set the date/time reviewed
S $P(BLRADATA,U,1)=BLRARFL,$P(BLRADATA,U,4)=BLRARDTM
S ^LR(LRDFN,LRSS,LRIDT,9009027)=BLRADATA
;
K BLRADATA,BLRARPHY,BLRARFL,BLRARDTM,BLRAACN
Q
;
UNSIG ; Unsign a lab result
I VALMLST<VALMCNT Q
; Ask if need to unsign result
S DIR("A")="DO YOU NEED TO UNSIGN THIS RESULT",DIR(0)="Y",DIR("B")="NO"
D ^DIR
K DIR
I $G(Y)'=1 Q
I $G(DIRUT)=1 K DIRUT Q
;
S BLRADATA=$G(^LR(LRDFN,LRSS,LRIDT,9009027))
;
; Kill off the old cross-reference and set new one
S BLRARPHY=$P(BLRADATA,U,2),BLRARFL=$P(BLRADATA,U,1)
D KX^BLRALUT1
;
; Set result flag from 'Reviewed, signed' to 'Reviewed, not signed'
I BLRARFL=2 S BLRARFL=1
D SX^BLRALUT1
;
; Clear out the date/time signed and signing physician
S $P(BLRADATA,U,1)=BLRARFL,$P(BLRADATA,U,3)="",$P(BLRADATA,U,5)=""
S ^LR(LRDFN,LRSS,LRIDT,9009027)=BLRADATA
;
K BLRADATA,BLRARPHY,BLRARFL
;
Q
BLRALFN1 ;DAOU/ALA-Lab ES Functions [ 11/18/2002 1:36 PM ]
+1 ;;5.2;LR;**1013,1015**;NOV 18, 2002
+2 ;
+3 ;**Program Description**
+4 ; This program contains three functions for the Lab
+5 ; Electronic Signature modification; SIGN, REVIEW, and
+6 ; UNSIGN.
+7 ;
SIGN ; Physician is signing
+1 ;I VALMLST<VALMCNT S VALMSG="YOU MUST SIGN ON THE LAST PAGE" D RE^VALM4 Q ; FIX #46
+2 IF VALMLST<VALMCNT
Begin DoDot:1
+3 WRITE !!,"**WARNING! You must sign on the last page.**"
+4 NEW DIR,X,Y
+5 SET DIR(0)="E"
SET DIR("T")=10
SET DIR("A")="Press return to continue "
DO ^DIR
+6 IF Y>0
SET BLRASFL=1
DO RE^VALM4
QUIT
End DoDot:1
+7 ;
+8 ; Set the date/time signed to the current date/time
+9 SET BLRASDTM=$$NOW^XLFDT()
+10 SET BLRADATA=$GET(^LR(LRDFN,LRSS,LRIDT,9009027))
+11 ;
+12 ; Kill off the old cross-reference and set new one
+13 SET BLRARPHY=$PIECE(BLRADATA,U,2)
SET BLRARFL=$PIECE(BLRADATA,U,1)
+14 ;
+15 ; Check for pending results flag
+16 SET BLRAPND=+$PIECE(BLRADATA,U,7)
+17 IF BLRAPND
DO EN^DDIOL("You cannot sign for a result with pending results","","!!")
QUIT
+18 ;
+19 DO KX^BLRALUT1
+20 ;
+21 ; Set result flag to 'Reviewed, signed'
+22 SET BLRARFL=$SELECT($GET(BLRASFL)'="":BLRASFL,1:2)
+23 DO SX^BLRALUT1
+24 ;
+25 SET $PIECE(BLRADATA,U,1)=BLRARFL
SET $PIECE(BLRADATA,U,3)=DUZ
SET $PIECE(BLRADATA,U,5)=BLRASDTM
+26 ;
+27 SET ^LR(LRDFN,LRSS,LRIDT,9009027)=BLRADATA
+28 ;
+29 KILL BLRADATA,BLRARPHY,BLRARFL,BLRASDTM,BLRAPND,BLRASFL
+30 ;
+31 QUIT
+32 ;
REVW ;EP
+1 ; Physician is reviewing only
+2 ; Set audit for review
+3 IF $GET(DFN)=""
SET DFN=$PIECE($GET(^LR(LRDFN,0)),U,3)
+4 SET BLRAACN=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),U,6)
+5 DO ^BLRALAU
+6 ;
+7 ; Set the date/time reviewed to the current date/time
+8 SET BLRARDTM=$$NOW^XLFDT()
+9 SET BLRADATA=$GET(^LR(LRDFN,LRSS,LRIDT,9009027))
+10 ;
+11 ; Kill off the old cross-reference and set new one
+12 SET BLRARPHY=$PIECE(BLRADATA,U,2)
SET BLRARFL=$PIECE(BLRADATA,U,1)
+13 ;
+14 ; If already signed, quit
+15 IF BLRARFL=2
KILL BLRARDTM,BLRADATA,BLRARPHY,BLRARFL
QUIT
+16 DO KX^BLRALUT1
+17 ;
+18 ; Set result flag to 'Reviewed, not signed'
+19 SET BLRARFL=1
+20 DO SX^BLRALUT1
+21 ;
+22 ; Set the date/time reviewed
+23 SET $PIECE(BLRADATA,U,1)=BLRARFL
SET $PIECE(BLRADATA,U,4)=BLRARDTM
+24 SET ^LR(LRDFN,LRSS,LRIDT,9009027)=BLRADATA
+25 ;
+26 KILL BLRADATA,BLRARPHY,BLRARFL,BLRARDTM,BLRAACN
+27 QUIT
+28 ;
UNSIG ; Unsign a lab result
+1 IF VALMLST<VALMCNT
QUIT
+2 ; Ask if need to unsign result
+3 SET DIR("A")="DO YOU NEED TO UNSIGN THIS RESULT"
SET DIR(0)="Y"
SET DIR("B")="NO"
+4 DO ^DIR
+5 KILL DIR
+6 IF $GET(Y)'=1
QUIT
+7 IF $GET(DIRUT)=1
KILL DIRUT
QUIT
+8 ;
+9 SET BLRADATA=$GET(^LR(LRDFN,LRSS,LRIDT,9009027))
+10 ;
+11 ; Kill off the old cross-reference and set new one
+12 SET BLRARPHY=$PIECE(BLRADATA,U,2)
SET BLRARFL=$PIECE(BLRADATA,U,1)
+13 DO KX^BLRALUT1
+14 ;
+15 ; Set result flag from 'Reviewed, signed' to 'Reviewed, not signed'
+16 IF BLRARFL=2
SET BLRARFL=1
+17 DO SX^BLRALUT1
+18 ;
+19 ; Clear out the date/time signed and signing physician
+20 SET $PIECE(BLRADATA,U,1)=BLRARFL
SET $PIECE(BLRADATA,U,3)=""
SET $PIECE(BLRADATA,U,5)=""
+21 SET ^LR(LRDFN,LRSS,LRIDT,9009027)=BLRADATA
+22 ;
+23 KILL BLRADATA,BLRARPHY,BLRARFL
+24 ;
+25 QUIT
