BLR36PST.m

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