Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRALFN1

BLRALFN1.m

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