BLR36PST ; IHS/MSC/MKK - IHS Lab Patch LR*5.2*1036 Post Routine ; 28-Jul-2015 06:30 ; MKK
;;5.2;IHS LABORATORY;**1036**;NOV 01, 1997;Build 10
;
EEP ; EP - Ersatz EP
D EEP^BLRGMENU
Q
;
PEP ; EP
POST ; EP - POST INSTALL
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
S QUIET=1
;
POSTDBG ; EP - POST INSTALL for DEBUG
;
D SETEVARS
;
S TODAY=$$DT^XLFDT
S WOTCNT=$$WOTCNT(BLRVERN)
;
D BMES^XPDUTL(CPSTR_" Post Install"),BLANK
;
D ADDNOPTS ; Add new options
;
D ENDINSTL(CP),BLANK
;
D BMES^XPDUTL("Laboratory Patch "_CPSTR_" INSTALL complete.")
;
Q:+$G(DEBUG)
;
D POSTMAIL(BLRVERN,CPSTR)
;
S ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT
Q
;
ADDNOPTS ; EP - ADD New OPTionS
Q:$G(DEBUG)
;
S TAB=$G(TAB,$J("",5))
;
D NEWOPT("BLRREFLABMENU","BLR REFLAB RESHIP NON LEDI","RSNL") ;add reship option
;
Q
;
NEWOPT(MENU,NEWOPTN,NEWSYNM,NEWORD) ; EP - Add Option to a Menu
NEW BLRIEN,TAB
;
S TAB=$J("",5)
;
S BLRIEN=$$LKOPT^XPDMENU(MENU)
Q:$$FIND1^DIC(19.01,","_BLRIEN_",",,NEWSYNM,"C") ; Don't add if already on MENU
;
D BMES^XPDUTL("Adding '"_NEWOPTN_"' option to "_MENU_".")
;
S X=$$ADD^XPDMENU(MENU,NEWOPTN,NEWSYNM,$G(NEWORD,""))
;
I X=1 D MES^XPDUTL(TAB_"'"_NEWOPTN_"' added to "_MENU_". OK."),BLANK Q
;
D MES^XPDUTL(TAB_"Error in adding '"_NEWOPTN_"' option to "_MENU_".")
D MES^XPDUTL(TAB_TAB_"Error Message: "_$$UP^XLFSTR($P(X,"^",2))),BLANK
;
Q
;
POSTMAIL(BLRVERN,CPSTR) ; EP - Post Install MailMan Message
NEW STR
;
S STR(1)=" "
S STR(2)=$J("",10)_"POST INSTALL of "_BLRVERN_" Routine."
S STR(3)=" "
S STR(4)=$J("",15)_"Laboratory Patch "_CPSTR_" INSTALL completed."
S STR(5)=" "
;
Q:+$G(DEBUG) ; No MailMan messages during debugging
;
; Send E-Mail to LMI Mail Group & Installer
D MAILALMI^BLRUTIL3("Laboratory Patch "_CPSTR_" INSTALL complete.",.STR,BLRVERN)
;
Q
;
; ========================= UTILITIES FOLLOW ==========================
;
SETEVARS ; EP - SET standard "Enviroment" VARiables.
S (CP,PATCHNUM)=$P($T(+2),"*",3)
S CPSTR="LR*5.2*"_CP
S BLRVERN=$TR($P($T(+1),";")," ")
Q
;
BLANK ; EP - Blank Line
D MES^XPDUTL(" ")
Q
;
MESCNTR(STR) ; EP - Center a line and use XPDUTL to display it
D MES^XPDUTL($$CJ^XLFSTR(STR,IOM))
Q
;
WOTCNT(BLRVERN) ; EP - Counter for ^XTMP
NEW CNT,TODAY
;
S TODAY=$$DT^XLFDT
;
S CNT=1+$G(^XTMP(BLRVERN,0,TODAY))
S ^XTMP(BLRVERN,0,TODAY)=CNT
Q $TR($J(CNT,3)," ","0")
;
INITSCR ; EP - Initialize screen. Cloned from INIT^XPDID
N X,XPDSTR
I IO'=IO(0)!(IOST'["C-VT") S XPDIDVT=0 Q
I $T(PREP^XGF)="" S XPDIDVT=0 Q
D PREP^XGF
S XPDIDVT=1,X="IOSTBM",XPDSTR=""
D ENDR^%ZISS
S IOTM=3,IOBM=IOSL-4
W @IOSTBM
D FRAME^XGF(IOTM-2,0,IOTM-2,IOM-1) ; Top line
; D FRAME^XGF(IOBM+1,0,IOBM+1,IOM-1) ; Bottom line
D IOXY^XGF(IOTM-2,0)
Q
;
DEBUG ; EP - Debugging Line Label for environment checker
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
; NOTE: DEBUG will not store "Backup" data.
;
D SETEVARS
;
W !!
W "Debug Routine ",BLRVERN," Begins:",!!
;
; Note -- DEBUG is a negative flag:
; 1="Don't Send Alerts"; 0="Send Alerts"
;
; D ^XBFMK
; S DIR(0)="YO"
; S DIR("B")="NO"
; S DIR("A")="Send Alerts/E-Mails"
; D ^DIR
; S:+$G(Y)=1 DEBUGA="YES"
;
S DEBUG=1 ; At this time, DO NOT ASK -- just DO NOT send alerts
;
W !
S XPDNM=CPSTR
S XPDENV=0
;
D ENVICHEK^BLRPRE35
D PRESSKEY^BLRGMENU(4)
;
Q:XPDABORT
;
D PRE^BLRPRE35
W !!!
;
D ^XBFMK
S DIR(0)="YO"
S DIR("B")="NO"
S DIR("A")="Test Post Install Code"
D ^DIR
;
S QUIET=0
D:+$G(Y)=1 POSTDBG
;
W !!,"Debug Routine ",BLRVERN," Ends.",!!
Q
;
ENDINSTL(CURPATCH) ; EP - End Installation
NEW INSTCNT ; Installation count
;
S INSTCNT=1+$O(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",""),-1)
;
S ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT)=DUZ_"^"_$$GET1^DIQ(200,DUZ,"NAME")
S ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5Z")
Q
;
WARMFZZY(ORDCNT) ; EP - "Warm Fuzzy" for user
S ORDCNT=ORDCNT+1
W:(ORDCNT#1000)=0 "."
W:$X>74 !,?4
Q
;
POSTIT(CP,MSG,BL) ; EP - Write the MSG string and store into the INSTALL file
NEW (BL,CP,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MSG,U,XPARSYS,XQXFLG)
;
S BL=$G(BL,0)
D:BL BMES^XPDUTL(MSG)
D:'BL MES^XPDUTL(MSG)
;
; Write message into the INSTALL file
S IEN=$O(^XPD(9.7,"B",CP,"A"),-1) ; Get Patch IEN
;
S LINE=$O(^XPD(9.7,IEN,"MES","A"),-1)+1
I BL S ^XPD(9.7,IEN,"MES",LINE,0)=" " S LINE=LINE+1
S ^XPD(9.7,IEN,"MES",LINE,0)=MSG
Q
BLR36PST ; IHS/MSC/MKK - IHS Lab Patch LR*5.2*1036 Post Routine ; 28-Jul-2015 06:30 ; MKK
+1 ;;5.2;IHS LABORATORY;**1036**;NOV 01, 1997;Build 10
+2 ;
EEP ; EP - Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
PEP ; EP
POST ; EP - POST INSTALL
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 SET QUIET=1
+4 ;
POSTDBG ; EP - POST INSTALL for DEBUG
+1 ;
+2 DO SETEVARS
+3 ;
+4 SET TODAY=$$DT^XLFDT
+5 SET WOTCNT=$$WOTCNT(BLRVERN)
+6 ;
+7 DO BMES^XPDUTL(CPSTR_" Post Install")
DO BLANK
+8 ;
+9 ; Add new options
DO ADDNOPTS
+10 ;
+11 DO ENDINSTL(CP)
DO BLANK
+12 ;
+13 DO BMES^XPDUTL("Laboratory Patch "_CPSTR_" INSTALL complete.")
+14 ;
+15 IF +$GET(DEBUG)
QUIT
+16 ;
+17 DO POSTMAIL(BLRVERN,CPSTR)
+18 ;
+19 SET ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT
+20 QUIT
+21 ;
ADDNOPTS ; EP - ADD New OPTionS
+1 IF $GET(DEBUG)
QUIT
+2 ;
+3 SET TAB=$GET(TAB,$JUSTIFY("",5))
+4 ;
+5 ;add reship option
DO NEWOPT("BLRREFLABMENU","BLR REFLAB RESHIP NON LEDI","RSNL")
+6 ;
+7 QUIT
+8 ;
NEWOPT(MENU,NEWOPTN,NEWSYNM,NEWORD) ; EP - Add Option to a Menu
+1 NEW BLRIEN,TAB
+2 ;
+3 SET TAB=$JUSTIFY("",5)
+4 ;
+5 SET BLRIEN=$$LKOPT^XPDMENU(MENU)
+6 ; Don't add if already on MENU
IF $$FIND1^DIC(19.01,","_BLRIEN_",",,NEWSYNM,"C")
QUIT
+7 ;
+8 DO BMES^XPDUTL("Adding '"_NEWOPTN_"' option to "_MENU_".")
+9 ;
+10 SET X=$$ADD^XPDMENU(MENU,NEWOPTN,NEWSYNM,$GET(NEWORD,""))
+11 ;
+12 IF X=1
DO MES^XPDUTL(TAB_"'"_NEWOPTN_"' added to "_MENU_". OK.")
DO BLANK
QUIT
+13 ;
+14 DO MES^XPDUTL(TAB_"Error in adding '"_NEWOPTN_"' option to "_MENU_".")
+15 DO MES^XPDUTL(TAB_TAB_"Error Message: "_$$UP^XLFSTR($PIECE(X,"^",2)))
DO BLANK
+16 ;
+17 QUIT
+18 ;
POSTMAIL(BLRVERN,CPSTR) ; EP - Post Install MailMan Message
+1 NEW STR
+2 ;
+3 SET STR(1)=" "
+4 SET STR(2)=$JUSTIFY("",10)_"POST INSTALL of "_BLRVERN_" Routine."
+5 SET STR(3)=" "
+6 SET STR(4)=$JUSTIFY("",15)_"Laboratory Patch "_CPSTR_" INSTALL completed."
+7 SET STR(5)=" "
+8 ;
+9 ; No MailMan messages during debugging
IF +$GET(DEBUG)
QUIT
+10 ;
+11 ; Send E-Mail to LMI Mail Group & Installer
+12 DO MAILALMI^BLRUTIL3("Laboratory Patch "_CPSTR_" INSTALL complete.",.STR,BLRVERN)
+13 ;
+14 QUIT
+15 ;
+16 ; ========================= UTILITIES FOLLOW ==========================
+17 ;
SETEVARS ; EP - SET standard "Enviroment" VARiables.
+1 SET (CP,PATCHNUM)=$PIECE($TEXT(+2),"*",3)
+2 SET CPSTR="LR*5.2*"_CP
+3 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+4 QUIT
+5 ;
BLANK ; EP - Blank Line
+1 DO MES^XPDUTL(" ")
+2 QUIT
+3 ;
MESCNTR(STR) ; EP - Center a line and use XPDUTL to display it
+1 DO MES^XPDUTL($$CJ^XLFSTR(STR,IOM))
+2 QUIT
+3 ;
WOTCNT(BLRVERN) ; EP - Counter for ^XTMP
+1 NEW CNT,TODAY
+2 ;
+3 SET TODAY=$$DT^XLFDT
+4 ;
+5 SET CNT=1+$GET(^XTMP(BLRVERN,0,TODAY))
+6 SET ^XTMP(BLRVERN,0,TODAY)=CNT
+7 QUIT $TRANSLATE($JUSTIFY(CNT,3)," ","0")
+8 ;
INITSCR ; EP - Initialize screen. Cloned from INIT^XPDID
+1 NEW X,XPDSTR
+2 IF IO'=IO(0)!(IOST'["C-VT")
SET XPDIDVT=0
QUIT
+3 IF $TEXT(PREP^XGF)=""
SET XPDIDVT=0
QUIT
+4 DO PREP^XGF
+5 SET XPDIDVT=1
SET X="IOSTBM"
SET XPDSTR=""
+6 DO ENDR^%ZISS
+7 SET IOTM=3
SET IOBM=IOSL-4
+8 WRITE @IOSTBM
+9 ; Top line
DO FRAME^XGF(IOTM-2,0,IOTM-2,IOM-1)
+10 ; D FRAME^XGF(IOBM+1,0,IOBM+1,IOM-1) ; Bottom line
+11 DO IOXY^XGF(IOTM-2,0)
+12 QUIT
+13 ;
DEBUG ; EP - Debugging Line Label for environment checker
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 ; NOTE: DEBUG will not store "Backup" data.
+4 ;
+5 DO SETEVARS
+6 ;
+7 WRITE !!
+8 WRITE "Debug Routine ",BLRVERN," Begins:",!!
+9 ;
+10 ; Note -- DEBUG is a negative flag:
+11 ; 1="Don't Send Alerts"; 0="Send Alerts"
+12 ;
+13 ; D ^XBFMK
+14 ; S DIR(0)="YO"
+15 ; S DIR("B")="NO"
+16 ; S DIR("A")="Send Alerts/E-Mails"
+17 ; D ^DIR
+18 ; S:+$G(Y)=1 DEBUGA="YES"
+19 ;
+20 ; At this time, DO NOT ASK -- just DO NOT send alerts
SET DEBUG=1
+21 ;
+22 WRITE !
+23 SET XPDNM=CPSTR
+24 SET XPDENV=0
+25 ;
+26 DO ENVICHEK^BLRPRE35
+27 DO PRESSKEY^BLRGMENU(4)
+28 ;
+29 IF XPDABORT
QUIT
+30 ;
+31 DO PRE^BLRPRE35
+32 WRITE !!!
+33 ;
+34 DO ^XBFMK
+35 SET DIR(0)="YO"
+36 SET DIR("B")="NO"
+37 SET DIR("A")="Test Post Install Code"
+38 DO ^DIR
+39 ;
+40 SET QUIET=0
+41 IF +$GET(Y)=1
DO POSTDBG
+42 ;
+43 WRITE !!,"Debug Routine ",BLRVERN," Ends.",!!
+44 QUIT
+45 ;
ENDINSTL(CURPATCH) ; EP - End Installation
+1 ; Installation count
NEW INSTCNT
+2 ;
+3 SET INSTCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",""),-1)
+4 ;
+5 SET ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT)=DUZ_"^"_$$GET1^DIQ(200,DUZ,"NAME")
+6 SET ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5Z")
+7 QUIT
+8 ;
WARMFZZY(ORDCNT) ; EP - "Warm Fuzzy" for user
+1 SET ORDCNT=ORDCNT+1
+2 IF (ORDCNT#1000)=0
WRITE "."
+3 IF $X>74
WRITE !,?4
+4 QUIT
+5 ;
POSTIT(CP,MSG,BL) ; EP - Write the MSG string and store into the INSTALL file
+1 NEW (BL,CP,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MSG,U,XPARSYS,XQXFLG)
+2 ;
+3 SET BL=$GET(BL,0)
+4 IF BL
DO BMES^XPDUTL(MSG)
+5 IF 'BL
DO MES^XPDUTL(MSG)
+6 ;
+7 ; Write message into the INSTALL file
+8 ; Get Patch IEN
SET IEN=$ORDER(^XPD(9.7,"B",CP,"A"),-1)
+9 ;
+10 SET LINE=$ORDER(^XPD(9.7,IEN,"MES","A"),-1)+1
+11 IF BL
SET ^XPD(9.7,IEN,"MES",LINE,0)=" "
SET LINE=LINE+1
+12 SET ^XPD(9.7,IEN,"MES",LINE,0)=MSG
+13 QUIT
