LRAPRES1 ;DALOI/WTY/KLL/CKA - AP ESIG RELEASE REPORT/ALERT; 13-Aug-2013 09:16 ; MKK
;;5.2;LAB SERVICE;**259,336,369,365,1030,397,413,1033**;NOV 01, 1997
;
;Reference to FILE^TIUSRVP supported by IA #3540
;Reference to ^TIULQ supported by IA #2693
;Reference to ^ORB3LAB supported by IA #4287
;Reference to DIC lookup on MAIL GROUP file (#3.8) supported by IA #10111
;
MAIN(LRDFN,LRSS,LRI,LRSF,LRP,LRAC) ;Main subroutine
Q:'$D(LRDFN)!('$D(LRSS))!('$D(LRP))!('$D(LRAC))
N LRDOCS,LRMSG,LRC,LRDOCSN,LRNUM,LRADL,LRMORE,LRQUIT,LRXQA
N DIR,DIRUT,DTOUT,DUOUT,X,Y,DIC,XQA,XQAMSG
S LRQUIT=0
I $G(LRAU) D
.S LRA=^LR(LRDFN,"AU")
.S LRI=$P(LRA,U)
D DOCS
Q:LRQUIT
D MORE
I LRMORE D LOOKUP
D SEND
Q
DOCS ;GET ORDERING PROVIDER AND PCP TO SEND ALERT
W !
S:$G(LRSF)="" LRSF=63
D GETDOCS^LRAPUTL(.LRDOCS,LRDFN,LRSS,$G(LRI),LRSF)
S:LRDOCS(1)=LRDOCS(2) LRDOCS(2)=0
F LRC=1:1:2 D
.I LRDOCS(LRC) D
..S LRDOCSN(LRC)=$$NAME^XUSER(LRDOCS(LRC),"F")
..I LRDOCSN(LRC)'="" S LRXQA(LRDOCS(LRC))=""
S LRNUM=1
K LRMSG
D
.S LRMSG(LRNUM)="Alert will be sent to:",LRMSG(LRNUM,"F")="!!"
.I LRDOCS(1) D
..S LRNUM=LRNUM+1,LRMSG(LRNUM)=LRDOCSN(1),LRMSG(LRNUM,"F")="?24"
.I LRDOCS(2) D
..S LRNUM=LRNUM+1,LRMSG(LRNUM)=LRDOCSN(2)
..S LRMSG(LRNUM,"F")=$S(LRDOCS(1):"!",1:"")_"?24"
I LRQUIT D
.S LRMSG(LRNUM)="No Ordering Provider or PCP for alert"
.S LRMSG(LRNUM,"F")="!!"
D EN^DDIOL(.LRMSG)
Q
MORE ;Add names or mail groups to the lookup list?
N DIR,DIRUT,DTOUT,DUOUT,X,Y
W !
S LRMORE=1
S DIR(0)="Y"
S DIR("A")="Send the alert to additional names or mail groups"
S X=$$GET^XPAR("USR^DIV^PKG","LRAPRES1 AP ALERT",1,"Q")
S X=$S(X=1:"YES",X=0:"NO",1:"NO")
S DIR("B")=X
D ^DIR
I Y=0 S LRMORE=0 Q
I $D(DUOUT)!($D(DTOUT)) S LRQUIT=1,LRMORE=0
Q
LOOKUP ;Add additional names or mail groups to alert list.
F D Q:LRQUIT
.W !
.K DIR
.;S DIR(0)="F^3:30^I X'?1""U."".E&(X'?1""G."".E) K X"
.S DIR(0)="FO^3:30^I X["".""&((X'?1""G."".E)&(X'?1""g."".E)) K X"
.S DIR("A")="Enter name or mail group"
.S DIR("?")="Enter lastname,firstname OR G.mailgroup OR ^ to exit"
.D ^DIR
.I $D(DIRUT) S LRQUIT=1 Q
.S X=Y,LRADL=""
.I Y["." S LRADL=$P(Y,"."),X=$P(Y,".",2)
.S Y=$$UP^XLFSTR(Y)
.I LRADL="g" S LRADL="G"
.K DIC
.S DIC(0)="QEZ"
.S DIC=$S(LRADL="G":3.8,1:200)
.D ^DIC
.Q:Y=-1
.S:LRADL="" XQA($P(Y,"^"))=""
.S:LRADL="G" XQA("G."_$P(Y,"^",2))=""
Q
SEND ; Send the alert
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
; Cannot send alert if OR*3.0*210 not installed on this UCI
; since that patch installs the ORB3LAB routine.
Q:'$$PATCH^XPDUTL("OR*3.0*210")
; ----- END IHS/MSC/MKK - LR*5.2*1031
;
;S XQAMSG=$E(LRP,1,9)_" ("_$E(LRP,1)_VA("BID")_"): Pathology report signed for "_LRAC_"."
;D SETUP^XQALERT
M XQA=LRXQA
D LAB^ORB3LAB(DFN,LRDFN,LRI,$G(LRA),LRSS,.XQA)
I $D(LRADL) D
. S LRMSG="Alerts have been sent to the specified additional users."
. D EN^DDIOL(LRMSG,"","!!")
. K LRMSG
Q
;
AHELP ;Help Frame
K LRMSG
S LRMSG(1)="If answered 'Yes', the alert will notify the primary care"
S LRMSG(1,"F")="!"
S LRMSG(2)="provider and the surgeon/physician that this report has"
S LRMSG(3)="been electronically signed and is now available for"
S LRMSG(4)="viewing. You will also have the opportunity to send the"
S LRMSG(5)="alert to additional names or mail groups."
D EN^DDIOL(.LRMSG)
Q
RETRACT(LRDFN,LRSS,LRI,LRTIUPTR) ;
;Change prior TIU versions of report to RETRACTED status
N LRROOT,LRIENS,LRFILE,LRTIUP,LRTIUAR,LRERR,LRSTAT,LRTIUX,LREXRR
I LRSS=""!("AUSPEMCY"'[LRSS) S LRPTR=0 Q
I LRSS="AU" D
.S LRROOT="^LR(LRDFN,101,""C""",LRIENS=LRDFN_","
.S LRFILE=63.101
I LRSS'="AU" D
.S LRROOT="^LR(LRDFN,LRSS,LRI,.05,""C"""
.S LRIENS=LRI_","_LRDFN_","
.S LRFILE=$S(LRSS="SP":63.19,LRSS="CY":63.47,LRSS="EM":63.49,1:"")
Q:'$D(@(LRROOT_")"))
S LRTIUP=0,LRTIUX(.05)=15
F S LRTIUP=$O(@(LRROOT_",LRTIUP)")) Q:LRTIUP'>0!(LRTIUP=LRTIUPTR) D
.K LRTIUAR S (LRSTAT,LRERR)=0
.D EXTRACT^TIULQ(LRTIUP,"LRTIUAR",.LRERR,".05",,,"I")
.Q:+LRERR
.M LRSTAT=LRTIUAR(LRTIUP,.05,"I")
.Q:LRSTAT'=7 ;Quit if current status is not COMPLETED
.D FILE^TIUSRVP(.LREXRR,LRTIUP,.LRTIUX)
.;Update new TIU version of report with previous TIU pointer value
.N LREXRR,LRTIUX
.S LRTIUX(1406)=LRTIUP
.D FILE^TIUSRVP(.LREXRR,LRTIUPTR,.LRTIUX)
Q
CLSSCHK(DUZ,LREND) ;Determine if user has the proper class settings and
;PROVIDER key
N LRMSG,LRPRCLSS,LRPCEXP,LRVCDE,LRPCSTR,LRMTCH
;First, check for PROVIDER key
I '$D(^XUSEC("PROVIDER",DUZ)) D Q
.K LRMSG S LRMSG=$C(7)_"Electronic signature not authorized. Missing "
.S LRMSG=LRMSG_"PROVIDER key."
.D EN^DDIOL(LRMSG,"","!!")
.K LRMSG S LREND=1
;Next, check the provider class
S LRPRCLSS=$$GET1^DIQ(200,DUZ_",",53.5)
;PROVIDER CL MUST CONTAIN PHYSICIAN, OR CYTOTECH ONLY FOR CY SECTION
;OR DENTIST FOR ORAL AND MAXILLOFACIAL PATHOLOGY
S LRMTCH=0
I LRPRCLSS'["PHYSICIAN",LRPRCLSS'["DENTIST" D
.I LRPRCLSS'["CYTOTECH" S LRMTCH=1
.I LRSS'="CY" S LRMTCH=1
I LRMTCH=1 D Q
.K LRMSG
.S LRMSG(1)=$C(7)_"You are not authorized to electronically sign "
.S LRMSG(1)=LRMSG(1)_"reports."
.S LRMSG(1,"F")="!!"
.S LRMSG(2)="PROVIDER CLASS must include PHYSICIAN,"
.S LRMSG(2,"F")="!"
.S LRMSG(3)=" OR CYTOTECHNOLOGIST FOR CY SECTIONS ONLY,"
.S LRMSG(3,"F")="!"
.S LRMSG(4)=" OR DENTIST FOR ORAL AND MAXILLOFACIAL PATHOLOGY."
.S LRMSG(4,"F")="!"
.D EN^DDIOL(.LRMSG) K LRMSG
.S LREND=1
;Finally, check the person class
S LRPCSTR=$$GET^XUA4A72(DUZ) ;Supported reference #1625
I LRPCSTR<0 D Q
.K LRMSG
.S LRMSG="PERSON CLASS is inactive or undefined. Electronic signature"
.S LRMSG=LRMSG_" is not authorized."
.D EN^DDIOL(LRMSG,"","!!")
.K LRMSG
.S LREND=1
S LRPCEXP=+$P(LRPCSTR,"^",6)
I LRPCEXP D Q
.K LRMSG
.S LRMSG="PERSON CLASS has expired. Electronic signature"
.S LRMSG=LRMSG_" is not authorized."
.D EN^DDIOL(LRMSG,"","!!") K LRMSG
.S LREND=1
S LRVCDE=$P(LRPCSTR,"^",7),LRMTCH=0
;CORRECT PERSON CLASS SHOULD MATCH PROVIDER CLASS
I LRPRCLSS["PHYSICIAN" D
.I $E(LRVCDE,1,6)="V11370","123568"[+$E(LRVCDE,7) S LRMTCH=1
.I $E(LRVCDE,1,6)="V11371","03"[+$E(LRVCDE,7) S LRMTCH=1
.I $E(LRVCDE,1,6)="V18240","124579"[+$E(LRVCDE,7) S LRMTCH=1
.I LRVCDE="V182413" S LRMTCH=1
I LRPRCLSS["CYTOTECH" D
.I LRVCDE="V150113" S LRMTCH=1
I LRPRCLSS["DENTIST" D
.I LRVCDE="V030503" S LRMTCH=1
I 'LRMTCH D
.K LRMSG
.S LRMSG="Invalid PERSON CLASS. Electronic Signature is not "
.S LRMSG=LRMSG_"authorized."
.D EN^DDIOL(LRMSG,"","!!")
.K LRMSG
.S LREND=1
Q
LRAPRES1 ;DALOI/WTY/KLL/CKA - AP ESIG RELEASE REPORT/ALERT; 13-Aug-2013 09:16 ; MKK
+1 ;;5.2;LAB SERVICE;**259,336,369,365,1030,397,413,1033**;NOV 01, 1997
+2 ;
+3 ;Reference to FILE^TIUSRVP supported by IA #3540
+4 ;Reference to ^TIULQ supported by IA #2693
+5 ;Reference to ^ORB3LAB supported by IA #4287
+6 ;Reference to DIC lookup on MAIL GROUP file (#3.8) supported by IA #10111
+7 ;
MAIN(LRDFN,LRSS,LRI,LRSF,LRP,LRAC) ;Main subroutine
+1 IF '$DATA(LRDFN)!('$DATA(LRSS))!('$DATA(LRP))!('$DATA(LRAC))
QUIT
+2 NEW LRDOCS,LRMSG,LRC,LRDOCSN,LRNUM,LRADL,LRMORE,LRQUIT,LRXQA
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,DIC,XQA,XQAMSG
+4 SET LRQUIT=0
+5 IF $GET(LRAU)
Begin DoDot:1
+6 SET LRA=^LR(LRDFN,"AU")
+7 SET LRI=$PIECE(LRA,U)
End DoDot:1
+8 DO DOCS
+9 IF LRQUIT
QUIT
+10 DO MORE
+11 IF LRMORE
DO LOOKUP
+12 DO SEND
+13 QUIT
DOCS ;GET ORDERING PROVIDER AND PCP TO SEND ALERT
+1 WRITE !
+2 IF $GET(LRSF)=""
SET LRSF=63
+3 DO GETDOCS^LRAPUTL(.LRDOCS,LRDFN,LRSS,$GET(LRI),LRSF)
+4 IF LRDOCS(1)=LRDOCS(2)
SET LRDOCS(2)=0
+5 FOR LRC=1:1:2
Begin DoDot:1
+6 IF LRDOCS(LRC)
Begin DoDot:2
+7 SET LRDOCSN(LRC)=$$NAME^XUSER(LRDOCS(LRC),"F")
+8 IF LRDOCSN(LRC)'=""
SET LRXQA(LRDOCS(LRC))=""
End DoDot:2
End DoDot:1
+9 SET LRNUM=1
+10 KILL LRMSG
+11 Begin DoDot:1
+12 SET LRMSG(LRNUM)="Alert will be sent to:"
SET LRMSG(LRNUM,"F")="!!"
+13 IF LRDOCS(1)
Begin DoDot:2
+14 SET LRNUM=LRNUM+1
SET LRMSG(LRNUM)=LRDOCSN(1)
SET LRMSG(LRNUM,"F")="?24"
End DoDot:2
+15 IF LRDOCS(2)
Begin DoDot:2
+16 SET LRNUM=LRNUM+1
SET LRMSG(LRNUM)=LRDOCSN(2)
+17 SET LRMSG(LRNUM,"F")=$SELECT(LRDOCS(1):"!",1:"")_"?24"
End DoDot:2
End DoDot:1
+18 IF LRQUIT
Begin DoDot:1
+19 SET LRMSG(LRNUM)="No Ordering Provider or PCP for alert"
+20 SET LRMSG(LRNUM,"F")="!!"
End DoDot:1
+21 DO EN^DDIOL(.LRMSG)
+22 QUIT
MORE ;Add names or mail groups to the lookup list?
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET LRMORE=1
+4 SET DIR(0)="Y"
+5 SET DIR("A")="Send the alert to additional names or mail groups"
+6 SET X=$$GET^XPAR("USR^DIV^PKG","LRAPRES1 AP ALERT",1,"Q")
+7 SET X=$SELECT(X=1:"YES",X=0:"NO",1:"NO")
+8 SET DIR("B")=X
+9 DO ^DIR
+10 IF Y=0
SET LRMORE=0
QUIT
+11 IF $DATA(DUOUT)!($DATA(DTOUT))
SET LRQUIT=1
SET LRMORE=0
+12 QUIT
LOOKUP ;Add additional names or mail groups to alert list.
+1 FOR
Begin DoDot:1
+2 WRITE !
+3 KILL DIR
+4 ;S DIR(0)="F^3:30^I X'?1""U."".E&(X'?1""G."".E) K X"
+5 SET DIR(0)="FO^3:30^I X["".""&((X'?1""G."".E)&(X'?1""g."".E)) K X"
+6 SET DIR("A")="Enter name or mail group"
+7 SET DIR("?")="Enter lastname,firstname OR G.mailgroup OR ^ to exit"
+8 DO ^DIR
+9 IF $DATA(DIRUT)
SET LRQUIT=1
QUIT
+10 SET X=Y
SET LRADL=""
+11 IF Y["."
SET LRADL=$PIECE(Y,".")
SET X=$PIECE(Y,".",2)
+12 SET Y=$$UP^XLFSTR(Y)
+13 IF LRADL="g"
SET LRADL="G"
+14 KILL DIC
+15 SET DIC(0)="QEZ"
+16 SET DIC=$SELECT(LRADL="G":3.8,1:200)
+17 DO ^DIC
+18 IF Y=-1
QUIT
+19 IF LRADL=""
SET XQA($PIECE(Y,"^"))=""
+20 IF LRADL="G"
SET XQA("G."_$PIECE(Y,"^",2))=""
End DoDot:1
IF LRQUIT
QUIT
+21 QUIT
SEND ; Send the alert
+1 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
+2 ; Cannot send alert if OR*3.0*210 not installed on this UCI
+3 ; since that patch installs the ORB3LAB routine.
+4 IF '$$PATCH^XPDUTL("OR*3.0*210")
QUIT
+5 ; ----- END IHS/MSC/MKK - LR*5.2*1031
+6 ;
+7 ;S XQAMSG=$E(LRP,1,9)_" ("_$E(LRP,1)_VA("BID")_"): Pathology report signed for "_LRAC_"."
+8 ;D SETUP^XQALERT
+9 MERGE XQA=LRXQA
+10 DO LAB^ORB3LAB(DFN,LRDFN,LRI,$GET(LRA),LRSS,.XQA)
+11 IF $DATA(LRADL)
Begin DoDot:1
+12 SET LRMSG="Alerts have been sent to the specified additional users."
+13 DO EN^DDIOL(LRMSG,"","!!")
+14 KILL LRMSG
End DoDot:1
+15 QUIT
+16 ;
AHELP ;Help Frame
+1 KILL LRMSG
+2 SET LRMSG(1)="If answered 'Yes', the alert will notify the primary care"
+3 SET LRMSG(1,"F")="!"
+4 SET LRMSG(2)="provider and the surgeon/physician that this report has"
+5 SET LRMSG(3)="been electronically signed and is now available for"
+6 SET LRMSG(4)="viewing. You will also have the opportunity to send the"
+7 SET LRMSG(5)="alert to additional names or mail groups."
+8 DO EN^DDIOL(.LRMSG)
+9 QUIT
RETRACT(LRDFN,LRSS,LRI,LRTIUPTR) ;
+1 ;Change prior TIU versions of report to RETRACTED status
+2 NEW LRROOT,LRIENS,LRFILE,LRTIUP,LRTIUAR,LRERR,LRSTAT,LRTIUX,LREXRR
+3 IF LRSS=""!("AUSPEMCY"'[LRSS)
SET LRPTR=0
QUIT
+4 IF LRSS="AU"
Begin DoDot:1
+5 SET LRROOT="^LR(LRDFN,101,""C"""
SET LRIENS=LRDFN_","
+6 SET LRFILE=63.101
End DoDot:1
+7 IF LRSS'="AU"
Begin DoDot:1
+8 SET LRROOT="^LR(LRDFN,LRSS,LRI,.05,""C"""
+9 SET LRIENS=LRI_","_LRDFN_","
+10 SET LRFILE=$SELECT(LRSS="SP":63.19,LRSS="CY":63.47,LRSS="EM":63.49,1:"")
End DoDot:1
+11 IF '$DATA(@(LRROOT_")"))
QUIT
+12 SET LRTIUP=0
SET LRTIUX(.05)=15
+13 FOR
SET LRTIUP=$ORDER(@(LRROOT_",LRTIUP)"))
IF LRTIUP'>0!(LRTIUP=LRTIUPTR)
QUIT
Begin DoDot:1
+14 KILL LRTIUAR
SET (LRSTAT,LRERR)=0
+15 DO EXTRACT^TIULQ(LRTIUP,"LRTIUAR",.LRERR,".05",,,"I")
+16 IF +LRERR
QUIT
+17 MERGE LRSTAT=LRTIUAR(LRTIUP,.05,"I")
+18 ;Quit if current status is not COMPLETED
IF LRSTAT'=7
QUIT
+19 DO FILE^TIUSRVP(.LREXRR,LRTIUP,.LRTIUX)
+20 ;Update new TIU version of report with previous TIU pointer value
+21 NEW LREXRR,LRTIUX
+22 SET LRTIUX(1406)=LRTIUP
+23 DO FILE^TIUSRVP(.LREXRR,LRTIUPTR,.LRTIUX)
End DoDot:1
+24 QUIT
CLSSCHK(DUZ,LREND) ;Determine if user has the proper class settings and
+1 ;PROVIDER key
+2 NEW LRMSG,LRPRCLSS,LRPCEXP,LRVCDE,LRPCSTR,LRMTCH
+3 ;First, check for PROVIDER key
+4 IF '$DATA(^XUSEC("PROVIDER",DUZ))
Begin DoDot:1
+5 KILL LRMSG
SET LRMSG=$CHAR(7)_"Electronic signature not authorized. Missing "
+6 SET LRMSG=LRMSG_"PROVIDER key."
+7 DO EN^DDIOL(LRMSG,"","!!")
+8 KILL LRMSG
SET LREND=1
End DoDot:1
QUIT
+9 ;Next, check the provider class
+10 SET LRPRCLSS=$$GET1^DIQ(200,DUZ_",",53.5)
+11 ;PROVIDER CL MUST CONTAIN PHYSICIAN, OR CYTOTECH ONLY FOR CY SECTION
+12 ;OR DENTIST FOR ORAL AND MAXILLOFACIAL PATHOLOGY
+13 SET LRMTCH=0
+14 IF LRPRCLSS'["PHYSICIAN"
IF LRPRCLSS'["DENTIST"
Begin DoDot:1
+15 IF LRPRCLSS'["CYTOTECH"
SET LRMTCH=1
+16 IF LRSS'="CY"
SET LRMTCH=1
End DoDot:1
+17 IF LRMTCH=1
Begin DoDot:1
+18 KILL LRMSG
+19 SET LRMSG(1)=$CHAR(7)_"You are not authorized to electronically sign "
+20 SET LRMSG(1)=LRMSG(1)_"reports."
+21 SET LRMSG(1,"F")="!!"
+22 SET LRMSG(2)="PROVIDER CLASS must include PHYSICIAN,"
+23 SET LRMSG(2,"F")="!"
+24 SET LRMSG(3)=" OR CYTOTECHNOLOGIST FOR CY SECTIONS ONLY,"
+25 SET LRMSG(3,"F")="!"
+26 SET LRMSG(4)=" OR DENTIST FOR ORAL AND MAXILLOFACIAL PATHOLOGY."
+27 SET LRMSG(4,"F")="!"
+28 DO EN^DDIOL(.LRMSG)
KILL LRMSG
+29 SET LREND=1
End DoDot:1
QUIT
+30 ;Finally, check the person class
+31 ;Supported reference #1625
SET LRPCSTR=$$GET^XUA4A72(DUZ)
+32 IF LRPCSTR<0
Begin DoDot:1
+33 KILL LRMSG
+34 SET LRMSG="PERSON CLASS is inactive or undefined. Electronic signature"
+35 SET LRMSG=LRMSG_" is not authorized."
+36 DO EN^DDIOL(LRMSG,"","!!")
+37 KILL LRMSG
+38 SET LREND=1
End DoDot:1
QUIT
+39 SET LRPCEXP=+$PIECE(LRPCSTR,"^",6)
+40 IF LRPCEXP
Begin DoDot:1
+41 KILL LRMSG
+42 SET LRMSG="PERSON CLASS has expired. Electronic signature"
+43 SET LRMSG=LRMSG_" is not authorized."
+44 DO EN^DDIOL(LRMSG,"","!!")
KILL LRMSG
+45 SET LREND=1
End DoDot:1
QUIT
+46 SET LRVCDE=$PIECE(LRPCSTR,"^",7)
SET LRMTCH=0
+47 ;CORRECT PERSON CLASS SHOULD MATCH PROVIDER CLASS
+48 IF LRPRCLSS["PHYSICIAN"
Begin DoDot:1
+49 IF $EXTRACT(LRVCDE,1,6)="V11370"
IF "123568"[+$EXTRACT(LRVCDE,7)
SET LRMTCH=1
+50 IF $EXTRACT(LRVCDE,1,6)="V11371"
IF "03"[+$EXTRACT(LRVCDE,7)
SET LRMTCH=1
+51 IF $EXTRACT(LRVCDE,1,6)="V18240"
IF "124579"[+$EXTRACT(LRVCDE,7)
SET LRMTCH=1
+52 IF LRVCDE="V182413"
SET LRMTCH=1
End DoDot:1
+53 IF LRPRCLSS["CYTOTECH"
Begin DoDot:1
+54 IF LRVCDE="V150113"
SET LRMTCH=1
End DoDot:1
+55 IF LRPRCLSS["DENTIST"
Begin DoDot:1
+56 IF LRVCDE="V030503"
SET LRMTCH=1
End DoDot:1
+57 IF 'LRMTCH
Begin DoDot:1
+58 KILL LRMSG
+59 SET LRMSG="Invalid PERSON CLASS. Electronic Signature is not "
+60 SET LRMSG=LRMSG_"authorized."
+61 DO EN^DDIOL(LRMSG,"","!!")
+62 KILL LRMSG
+63 SET LREND=1
End DoDot:1
+64 QUIT
