- 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