LR305 ;DALOI/WTY - LR*5.2*305 PATCH ENVIRONMENT CHECK ROUTINE;02/18/2004
;;5.2;LR;**305,1022**;September 20, 2007
;;
; VA PATCH 305 included in IHS LAB PATCH 1022
;;
EN ; Does not prevent loading of the transport global.
; Environment check is done only during the install.
;
N XQA,XQAMSG,LRAMSG
;
I '$G(XPDENV) D Q
. S XQAMSG="Transport global for patch "_$G(XPDNM,"Unknown patch")
. S XQAMSG=XQAMSG_" loaded on "_$$HTE^XLFDT($H)
. S XQA("G.LMI")=""
. D SETUP^XQALERT
. S LRAMSG="Sending transport global loaded alert to mail group G.LMI"
. D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
;
S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" started "
S XQAMSG=XQAMSG_"on "_$$HTE^XLFDT($H)
S XQA("G.LMI")=""
D SETUP^XQALERT
S LRAMSG="Sending install started alert to mail group G.LMI"
D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
;
D CHECK
D EXIT
Q
;
CHECK ; Perform environment check
I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D Q
. D BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",80))
. S XPDQUIT=2
I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D Q
. S LRAMSG="Please log in to set local DUZ... variables"
. D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
. S XPDQUIT=2
I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D Q
. S LRAMSG="You are not a valid user on this system"
. D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
. S XPDQUIT=2
S XPDIQ("XPZ1","B")="NO"
Q
;
;
EXIT ;
I $G(XPDQUIT) D
.D BMES^XPDUTL($$CJ^XLFSTR("--- Install Environment Check FAILED ---",80))
I '$G(XPDQUIT) D
.D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is OK ---",80))
Q
;
;
PRE ; KIDS Pre install
D BMES^XPDUTL($$CJ^XLFSTR("*** Pre install started ***",80))
D BMES^XPDUTL($$CJ^XLFSTR("*** No action required ***",80))
D BMES^XPDUTL($$CJ^XLFSTR("*** Pre install completed ***",80))
Q
;
;
POST ; KIDS Post install
N XQA,XQAMSG,LRNUM,LRFDA,LRERR,LREND
D BMES^XPDUTL($$CJ^XLFSTR("*** Post install started ***",80))
S LRAMSG="Set ALLOW LAB TO ADD PATIENTS (#13) field of the"
D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
S LRAMSG="LABORATORY SITE (#69.9) file to 'NO'"
D MES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
;Set field #13 of file 69.9 to 'No'
S (LRNUM,LREND)=0
F S LRNUM=$O(^LAB(69.9,LRNUM)) Q:'LRNUM D
.L +^LAB(69.9,LRNUM,0):5 I '$T D Q
..S LRAMSG="The record is locked by another user. "
..S LRAMSG=LRAMSG_"Record cannot be updated."
..D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
..S LRAMSG="Please contact IRM for assistance."
..D MES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
.K LRFDA,LRERR
.Q:'$D(^LAB(69.9,LRNUM,0))
.S LRFDA(69.9,LRNUM_",",13)=0
.D FILE^DIE("","LRFDA","LRERR")
.I $D(LRERR) D
..S LREND=1
..S LRAMSG="An error occurred while attempting to update "
..S LRAMSG=LRAMSG_"the file."
..D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
..S LRAMSG="Please contact IRM for assistance."
..D MES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
.I 'LREND D
..S LRAMSG="File Update Completed"
..D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
.L -^LAB(69.9,LRNUM,0)
D BMES^XPDUTL($$CJ^XLFSTR("*** Post install completed ***",80))
S LRAMSG="Sending install completion alert to mail group G.LMI"
D BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")
S XQAMSG=XQAMSG_" completed on "_$$HTE^XLFDT($H)
S XQA("G.LMI")=""
D SETUP^XQALERT
Q
LR305 ;DALOI/WTY - LR*5.2*305 PATCH ENVIRONMENT CHECK ROUTINE;02/18/2004
+1 ;;5.2;LR;**305,1022**;September 20, 2007
+2 ;;
+3 ; VA PATCH 305 included in IHS LAB PATCH 1022
+4 ;;
EN ; Does not prevent loading of the transport global.
+1 ; Environment check is done only during the install.
+2 ;
+3 NEW XQA,XQAMSG,LRAMSG
+4 ;
+5 IF '$GET(XPDENV)
Begin DoDot:1
+6 SET XQAMSG="Transport global for patch "_$GET(XPDNM,"Unknown patch")
+7 SET XQAMSG=XQAMSG_" loaded on "_$$HTE^XLFDT($HOROLOG)
+8 SET XQA("G.LMI")=""
+9 DO SETUP^XQALERT
+10 SET LRAMSG="Sending transport global loaded alert to mail group G.LMI"
+11 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
End DoDot:1
QUIT
+12 ;
+13 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" started "
+14 SET XQAMSG=XQAMSG_"on "_$$HTE^XLFDT($HOROLOG)
+15 SET XQA("G.LMI")=""
+16 DO SETUP^XQALERT
+17 SET LRAMSG="Sending install started alert to mail group G.LMI"
+18 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
+19 ;
+20 DO CHECK
+21 DO EXIT
+22 QUIT
+23 ;
CHECK ; Perform environment check
+1 IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
Begin DoDot:1
+2 DO BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",80))
+3 SET XPDQUIT=2
End DoDot:1
QUIT
+4 IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
Begin DoDot:1
+5 SET LRAMSG="Please log in to set local DUZ... variables"
+6 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
+7 SET XPDQUIT=2
End DoDot:1
QUIT
+8 IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1
Begin DoDot:1
+9 SET LRAMSG="You are not a valid user on this system"
+10 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
+11 SET XPDQUIT=2
End DoDot:1
QUIT
+12 SET XPDIQ("XPZ1","B")="NO"
+13 QUIT
+14 ;
+15 ;
EXIT ;
+1 IF $GET(XPDQUIT)
Begin DoDot:1
+2 DO BMES^XPDUTL($$CJ^XLFSTR("--- Install Environment Check FAILED ---",80))
End DoDot:1
+3 IF '$GET(XPDQUIT)
Begin DoDot:1
+4 DO BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is OK ---",80))
End DoDot:1
+5 QUIT
+6 ;
+7 ;
PRE ; KIDS Pre install
+1 DO BMES^XPDUTL($$CJ^XLFSTR("*** Pre install started ***",80))
+2 DO BMES^XPDUTL($$CJ^XLFSTR("*** No action required ***",80))
+3 DO BMES^XPDUTL($$CJ^XLFSTR("*** Pre install completed ***",80))
+4 QUIT
+5 ;
+6 ;
POST ; KIDS Post install
+1 NEW XQA,XQAMSG,LRNUM,LRFDA,LRERR,LREND
+2 DO BMES^XPDUTL($$CJ^XLFSTR("*** Post install started ***",80))
+3 SET LRAMSG="Set ALLOW LAB TO ADD PATIENTS (#13) field of the"
+4 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
+5 SET LRAMSG="LABORATORY SITE (#69.9) file to 'NO'"
+6 DO MES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
+7 ;Set field #13 of file 69.9 to 'No'
+8 SET (LRNUM,LREND)=0
+9 FOR
SET LRNUM=$ORDER(^LAB(69.9,LRNUM))
IF 'LRNUM
QUIT
Begin DoDot:1
+10 LOCK +^LAB(69.9,LRNUM,0):5
IF '$TEST
Begin DoDot:2
+11 SET LRAMSG="The record is locked by another user. "
+12 SET LRAMSG=LRAMSG_"Record cannot be updated."
+13 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
+14 SET LRAMSG="Please contact IRM for assistance."
+15 DO MES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
End DoDot:2
QUIT
+16 KILL LRFDA,LRERR
+17 IF '$DATA(^LAB(69.9,LRNUM,0))
QUIT
+18 SET LRFDA(69.9,LRNUM_",",13)=0
+19 DO FILE^DIE("","LRFDA","LRERR")
+20 IF $DATA(LRERR)
Begin DoDot:2
+21 SET LREND=1
+22 SET LRAMSG="An error occurred while attempting to update "
+23 SET LRAMSG=LRAMSG_"the file."
+24 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
+25 SET LRAMSG="Please contact IRM for assistance."
+26 DO MES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
End DoDot:2
+27 IF 'LREND
Begin DoDot:2
+28 SET LRAMSG="File Update Completed"
+29 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
End DoDot:2
+30 LOCK -^LAB(69.9,LRNUM,0)
End DoDot:1
+31 DO BMES^XPDUTL($$CJ^XLFSTR("*** Post install completed ***",80))
+32 SET LRAMSG="Sending install completion alert to mail group G.LMI"
+33 DO BMES^XPDUTL($$CJ^XLFSTR(LRAMSG,80))
+34 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")
+35 SET XQAMSG=XQAMSG_" completed on "_$$HTE^XLFDT($HOROLOG)
+36 SET XQA("G.LMI")=""
+37 DO SETUP^XQALERT
+38 QUIT
