- 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
