BLR35PST ; IHS/MSC/MKK - IHS Lab Patch LR*5.2*1035 Post Routine ; 28-Jul-2015 06:30 ; MKK
;;5.2;IHS LABORATORY;**1035**;NOV 01, 1997;Build 5
;
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 NOSNAPS^BLRKIDS2(QUIET) ; Make sure TAKE SNAPSHOTS field in BLR MASTER CONTROL is OFF
D LABJRNL ; Get rid of extraneous LAB JOURNAL pointers in file 61.2
D OERRSTSC^BLR7OB1 ; Change Any Order's deleted test's OERR Status from PENDING (LR*5.2*1033 Bug)
D NOPCEON ; Make sure LABORATORY SITE (#69.9) file's PCE/VSIT ON field is OFF
D CLEANUP ; Make sure ^BLRENTRY global is Reset
D BADOERRC ; Clean up BAD OE/RR Numbers in File 69
;
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("BLRMENU","BLR PURGE ALERTS","PURG",90) ; Purge Alerts
D NEWOPT("BLRMENU","BLRGUIER","GUIR") ; Lab GUI Accession Reports
D NEWOPT("BLRMENU","BLRLROS","LROS") ; RPMS Lab Order/Test Status
D NEWOPT("BLRMENU","BLRHLMIR","MONJ") ; Monitor Jobs & HLZTCP
D NEWOPT("LRSUPERVISOR","BLR Parameter Utilities","EPAR") ; Edit IHS Laboratory XPAR Parameters
;
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
;
LABJRNL ; EP - Get rid of pointers in file 61.2 that point to an empty File 95.
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:+$O(^LAB(95,0)) ; If there is no data in file 95, don't do anything
;
S CNT=0,IEN=.9999999
F S IEN=$O(^LAB(61.2,IEN)) Q:IEN<1 D
. S JOURN=0 F S JOURN=$O(^LAB(61.2,IEN,"JR",JOURN)) Q:JOURN<1 D
.. S CNT=CNT+1
.. I CNT=1 D
... S ^XTMP("LABJOURNL",0)=$$HTFM^XLFDT(+$H+365)_"^"_$$DT^XLFDT_"^Entries In File 61.2 that Pointed to (Empty) File 95"
.. S ^XTMP("LABJOURNL","61.2","IEN",IEN)=""
.. M ^XTMP("LABJOURNL","61.2","IEN",IEN,"JOURN",JOURN)=^LAB(61.2,IEN,"JR",JOURN)
.. ;
.. K DA
.. S DA(1)=IEN,DA=JOURN
.. S DIK="^LAB(61.2,"_DA(1)_",""JR"","
.. D ^DIK
;
S:CNT ^XTMP("LABJOURNL","61.2")=CNT
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
;
CHKBCKUP ; EP - Check to determine if BACKUP has been performed.
NEW CP ; Current Patch
S CP=$TR($P($T(+2),";",5),"*")
;
D PASSMESG^BLRPRE31("ATTENTION")
W !
;
D ^XBFMK
S DIR(0)="Y"
S DIR("B")="NO"
S DIR("A")=$J("",10)_"Has a >> SUCCESSFUL << backup been performed?"
D ^DIR
W !
;
I +$G(Y)'=1 D Q ; If BACKUP not performed, then ABORT installation.
. S XPDABORT=1
. D PASSMESG^BLRPRE31("ATTENTION")
. D BMES^XPDUTL($J("",15)_"SUCCESSFUL system backup has >>> NOT <<< been confirmed.")
. D BMES^XPDUTL($J("",25)_"Installer: "_$$GET1^DIQ(200,DUZ,"NAME")_" ["_DUZ_"].")
. D BMES^XPDUTL($J("",15)_"Install Aborting.")
. H 1 ; Pause 1 second to let the user see the message.
;
; Store backup confirmation person & date/time
S BCKUPCNT=1+$O(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)
S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=DUZ_"^"_$P($G(^VA(200,DUZ,0)),U)
S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5MZ")
;
D BOKAY^BLRKIDS2("SUCCESSFUL system backup CONFIRMED by: "_$$GET1^DIQ(200,DUZ,"NAME")_".",5)
H 1 ; Pause 1 second to let the user see the message.
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
;
NOPCEON ; EP - Ensure LABORATORY SITE (#69.9) file's PCE VISIT ON field is OFF if PCE not installed.
NEW FDA,ERRS
;
Q:+$$PATCH^BLRUTIL4("PX*1.0*200") ; Skip if PCE is installed.
;
; PCE not installed.
S FDA(69.9,"1,",615)=0
D UPDATE^DIE("S","FDA",,"ERRS")
I $D(ERRS)<1 D Q
. D BOKAY^BLRKIDS2("LABORATORY SITE (#69.9) file's PCE VISIT ON field is OFF.",5)
;
D BMES^XPDUTL("LABORATORY SITE (#69.9) file's PCE VISIT ON field was NOT set to OFF.")
Q
;
CLEANUP ; EP - Ensure ^BLRENTRY global is purged
NEW DEBUGGLO
;
Q:$D(^BLRENTRY)<1 ; Skip if ^BLRENTRY is null
;
S DEBUGGLO="^BLRENTRY"
K @DEBUGGLO
Q
;
BADOERRC ; EP - Clean Up OERR Data in File 69
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D BMES^XPDUTL("Lab Order Entry (#69) File Analysis.")
S LRODT=.9999999,(BADCNT,BADOCNT,BADTCNT,CNT,DELCNT,ERRSCNT,ORDCNT)=0
W ?4
F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT<1 D
. S LRSP=0
. F S LRSP=$O(^LRO(69,LRODT,1,LRSP)) Q:LRSP<1 D
.. D WARMFZZY(.ORDCNT)
.. D CHKOERRO(LRODT,LRSP)
.. S LROT=0
.. F S LROT=$O(^LRO(69,LRODT,1,LRSP,2,LROT)) Q:LROT<1 D
... D CHKOERRT(LRODT,LRSP,LROT)
;
W:$X>4 !
;
D BOKAY^BLRKIDS2(ORDCNT_" Orders analyzed.",5)
I BADCNT<1 D TABMENU^BLRKIDSU(" No anomalies detected.",10) Q
;
D:BADCNT TABMENU^BLRKIDSU(BADCNT_" Bad Entr"_$$PLURALI^BLRUTIL7(BADCNT)_".",10)
D:BADOCNT TABMENU^BLRKIDSU(BADOCNT_"Bad Entr"_$$PLURALI^BLRUTIL7(BADOCNT)_" at the Order Level.",15)
D:BADTCNT TABMENU^BLRKIDSU(BADOCNT_"Bad Entr"_$$PLURALI^BLRUTIL7(BADTCNT)_" at the Test Level.",15)
D:DELCNT TABMENU^BLRKIDSU(DELCNT_" Bad Entr"_$$PLURALI^BLRUTIL7(DELCNT)_" Deleted.",10)
D:ERRSCNT TABMENU^BLRKIDSU(ERRSCNT_" Error"_$$PLURAL^BLRUTIL7(ERRSCNT)_" occurred during FILE^DIE.",15)
;
Q
;
WARMFZZY(ORDCNT) ; EP - "Warm Fuzzy" for user
S ORDCNT=ORDCNT+1
W:(ORDCNT#1000)=0 "."
W:$X>74 !,?4
Q
;
CHKOERRO(LRODT,LRSP) ; EP - Delete invalid OERR #'s at the Order level
NEW ERRS,FDA,OERRNUM
;
S OERRNUM=+$P($G(^LRO(69,LRODT,1,LRSP,0)),U,11)
Q:OERRNUM<1 ; If no OERR number, skip
Q:+$G(^OR(100,OERRNUM,0)) ; Skip if OERR # valid
;
S BADCNT=BADCNT+1
S BADOCNT=BADOCNT+1
K FDA,ERRS
S FDA(69.01,LRSP_","_LRODT_",",.11)="@"
D FILE^DIE("KS","FDA","ERRS")
;
I $D(ERRS)<1 S DELCNT=DELCNT+1 Q
;
D SAVERRS(.FDA,.ERRS,"Order OERR Number Error.")
Q
;
CHKOERRT(LRODT,LRSP,LROT) ; EP - Delete invalid OERR #'s at the Test level
NEW ERRS,FDA,OERRNUM
;
S OERRNUM=+$P($G(^LRO(69,LRODT,1,LRSP,2,LROT,0)),U,7)
Q:OERRNUM<1 ; If no OERR number, skip
Q:+$G(^OR(100,OERRNUM,0)) ; Skip if OERR # valid
;
S BADCNT=BADCNT+1
S BADTCNT=BADTCNT+1
K FDA,ERRS
S FDA(69.03,LROT_","_LRSP_","_LRODT_",",6)="@"
D FILE^DIE("KS","FDA","ERRS")
;
I $D(ERRS)<1 S DELCNT=DELCNT+1 Q
;
D SAVERRS(.FDA,.ERRS,"Test OERR Number Error.") S ERRSCNT=ERRSCNT+1
Q
;
SAVERRS(FDA,ERR,MSG) ; EP
NEW DAYSPURG,NOW
;
S DAYSPURG=$$HTFM^XLFDT(+$H+180)
S:$P($G(^XTMP("BLRPRE35",0)),U)<DAYSPURG ^XTMP("BLRPRE35",0)=DAYSPURG_U_DT_U_"LR*5.2*1035"
S:$G(^XTMP("BLRPRE35","69"))'["BLR35PST Routine." ^XTMP("BLRPRE35","69")="BLR35PST Routine. Lab Order Entry Anamolies"_U_DT
S NOW=$H
M ^XTMP("BLRPRE35","69",NOW,"A FDA")=FDA
M ^XTMP("BLRPRE35","69",NOW,"B ERRS")=ERRS
S ^XTMP("BLRPRE35","69",NOW,"C MSG")=MSG
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
BLR35PST ; IHS/MSC/MKK - IHS Lab Patch LR*5.2*1035 Post Routine ; 28-Jul-2015 06:30 ; MKK
+1 ;;5.2;IHS LABORATORY;**1035**;NOV 01, 1997;Build 5
+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 ; Make sure TAKE SNAPSHOTS field in BLR MASTER CONTROL is OFF
DO NOSNAPS^BLRKIDS2(QUIET)
+10 ; Get rid of extraneous LAB JOURNAL pointers in file 61.2
DO LABJRNL
+11 ; Change Any Order's deleted test's OERR Status from PENDING (LR*5.2*1033 Bug)
DO OERRSTSC^BLR7OB1
+12 ; Make sure LABORATORY SITE (#69.9) file's PCE/VSIT ON field is OFF
DO NOPCEON
+13 ; Make sure ^BLRENTRY global is Reset
DO CLEANUP
+14 ; Clean up BAD OE/RR Numbers in File 69
DO BADOERRC
+15 ;
+16 DO ENDINSTL(CP)
DO BLANK
+17 ;
+18 DO BMES^XPDUTL("Laboratory Patch "_CPSTR_" INSTALL complete.")
+19 ;
+20 IF +$GET(DEBUG)
QUIT
+21 ;
+22 DO POSTMAIL(BLRVERN,CPSTR)
+23 ;
+24 SET ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT
+25 QUIT
+26 ;
ADDNOPTS ; EP - ADD New OPTionS
+1 IF $GET(DEBUG)
QUIT
+2 ;
+3 SET TAB=$GET(TAB,$JUSTIFY("",5))
+4 ;
+5 ; Purge Alerts
DO NEWOPT("BLRMENU","BLR PURGE ALERTS","PURG",90)
+6 ; Lab GUI Accession Reports
DO NEWOPT("BLRMENU","BLRGUIER","GUIR")
+7 ; RPMS Lab Order/Test Status
DO NEWOPT("BLRMENU","BLRLROS","LROS")
+8 ; Monitor Jobs & HLZTCP
DO NEWOPT("BLRMENU","BLRHLMIR","MONJ")
+9 ; Edit IHS Laboratory XPAR Parameters
DO NEWOPT("LRSUPERVISOR","BLR Parameter Utilities","EPAR")
+10 ;
+11 QUIT
+12 ;
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 ;
LABJRNL ; EP - Get rid of pointers in file 61.2 that point to an empty File 95.
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 ; If there is no data in file 95, don't do anything
IF +$ORDER(^LAB(95,0))
QUIT
+4 ;
+5 SET CNT=0
SET IEN=.9999999
+6 FOR
SET IEN=$ORDER(^LAB(61.2,IEN))
IF IEN<1
QUIT
Begin DoDot:1
+7 SET JOURN=0
FOR
SET JOURN=$ORDER(^LAB(61.2,IEN,"JR",JOURN))
IF JOURN<1
QUIT
Begin DoDot:2
+8 SET CNT=CNT+1
+9 IF CNT=1
Begin DoDot:3
+10 SET ^XTMP("LABJOURNL",0)=$$HTFM^XLFDT(+$HOROLOG+365)_"^"_$$DT^XLFDT_"^Entries In File 61.2 that Pointed to (Empty) File 95"
End DoDot:3
+11 SET ^XTMP("LABJOURNL","61.2","IEN",IEN)=""
+12 MERGE ^XTMP("LABJOURNL","61.2","IEN",IEN,"JOURN",JOURN)=^LAB(61.2,IEN,"JR",JOURN)
+13 ;
+14 KILL DA
+15 SET DA(1)=IEN
SET DA=JOURN
+16 SET DIK="^LAB(61.2,"_DA(1)_",""JR"","
+17 DO ^DIK
End DoDot:2
End DoDot:1
+18 ;
+19 IF CNT
SET ^XTMP("LABJOURNL","61.2")=CNT
+20 QUIT
+21 ;
+22 ; ========================= UTILITIES FOLLOW ==========================
+23 ;
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 ;
CHKBCKUP ; EP - Check to determine if BACKUP has been performed.
+1 ; Current Patch
NEW CP
+2 SET CP=$TRANSLATE($PIECE($TEXT(+2),";",5),"*")
+3 ;
+4 DO PASSMESG^BLRPRE31("ATTENTION")
+5 WRITE !
+6 ;
+7 DO ^XBFMK
+8 SET DIR(0)="Y"
+9 SET DIR("B")="NO"
+10 SET DIR("A")=$JUSTIFY("",10)_"Has a >> SUCCESSFUL << backup been performed?"
+11 DO ^DIR
+12 WRITE !
+13 ;
+14 ; If BACKUP not performed, then ABORT installation.
IF +$GET(Y)'=1
Begin DoDot:1
+15 SET XPDABORT=1
+16 DO PASSMESG^BLRPRE31("ATTENTION")
+17 DO BMES^XPDUTL($JUSTIFY("",15)_"SUCCESSFUL system backup has >>> NOT <<< been confirmed.")
+18 DO BMES^XPDUTL($JUSTIFY("",25)_"Installer: "_$$GET1^DIQ(200,DUZ,"NAME")_" ["_DUZ_"].")
+19 DO BMES^XPDUTL($JUSTIFY("",15)_"Install Aborting.")
+20 ; Pause 1 second to let the user see the message.
HANG 1
End DoDot:1
QUIT
+21 ;
+22 ; Store backup confirmation person & date/time
+23 SET BCKUPCNT=1+$ORDER(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)
+24 SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=DUZ_"^"_$PIECE($GET(^VA(200,DUZ,0)),U)
+25 SET ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($HOROLOG,"5MZ")
+26 ;
+27 DO BOKAY^BLRKIDS2("SUCCESSFUL system backup CONFIRMED by: "_$$GET1^DIQ(200,DUZ,"NAME")_".",5)
+28 ; Pause 1 second to let the user see the message.
HANG 1
+29 QUIT
+30 ;
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 ;
NOPCEON ; EP - Ensure LABORATORY SITE (#69.9) file's PCE VISIT ON field is OFF if PCE not installed.
+1 NEW FDA,ERRS
+2 ;
+3 ; Skip if PCE is installed.
IF +$$PATCH^BLRUTIL4("PX*1.0*200")
QUIT
+4 ;
+5 ; PCE not installed.
+6 SET FDA(69.9,"1,",615)=0
+7 DO UPDATE^DIE("S","FDA",,"ERRS")
+8 IF $DATA(ERRS)<1
Begin DoDot:1
+9 DO BOKAY^BLRKIDS2("LABORATORY SITE (#69.9) file's PCE VISIT ON field is OFF.",5)
End DoDot:1
QUIT
+10 ;
+11 DO BMES^XPDUTL("LABORATORY SITE (#69.9) file's PCE VISIT ON field was NOT set to OFF.")
+12 QUIT
+13 ;
CLEANUP ; EP - Ensure ^BLRENTRY global is purged
+1 NEW DEBUGGLO
+2 ;
+3 ; Skip if ^BLRENTRY is null
IF $DATA(^BLRENTRY)<1
QUIT
+4 ;
+5 SET DEBUGGLO="^BLRENTRY"
+6 KILL @DEBUGGLO
+7 QUIT
+8 ;
BADOERRC ; EP - Clean Up OERR Data in File 69
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO BMES^XPDUTL("Lab Order Entry (#69) File Analysis.")
+4 SET LRODT=.9999999
SET (BADCNT,BADOCNT,BADTCNT,CNT,DELCNT,ERRSCNT,ORDCNT)=0
+5 WRITE ?4
+6 FOR
SET LRODT=$ORDER(^LRO(69,LRODT))
IF LRODT<1
QUIT
Begin DoDot:1
+7 SET LRSP=0
+8 FOR
SET LRSP=$ORDER(^LRO(69,LRODT,1,LRSP))
IF LRSP<1
QUIT
Begin DoDot:2
+9 DO WARMFZZY(.ORDCNT)
+10 DO CHKOERRO(LRODT,LRSP)
+11 SET LROT=0
+12 FOR
SET LROT=$ORDER(^LRO(69,LRODT,1,LRSP,2,LROT))
IF LROT<1
QUIT
Begin DoDot:3
+13 DO CHKOERRT(LRODT,LRSP,LROT)
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 IF $X>4
WRITE !
+16 ;
+17 DO BOKAY^BLRKIDS2(ORDCNT_" Orders analyzed.",5)
+18 IF BADCNT<1
DO TABMENU^BLRKIDSU(" No anomalies detected.",10)
QUIT
+19 ;
+20 IF BADCNT
DO TABMENU^BLRKIDSU(BADCNT_" Bad Entr"_$$PLURALI^BLRUTIL7(BADCNT)_".",10)
+21 IF BADOCNT
DO TABMENU^BLRKIDSU(BADOCNT_"Bad Entr"_$$PLURALI^BLRUTIL7(BADOCNT)_" at the Order Level.",15)
+22 IF BADTCNT
DO TABMENU^BLRKIDSU(BADOCNT_"Bad Entr"_$$PLURALI^BLRUTIL7(BADTCNT)_" at the Test Level.",15)
+23 IF DELCNT
DO TABMENU^BLRKIDSU(DELCNT_" Bad Entr"_$$PLURALI^BLRUTIL7(DELCNT)_" Deleted.",10)
+24 IF ERRSCNT
DO TABMENU^BLRKIDSU(ERRSCNT_" Error"_$$PLURAL^BLRUTIL7(ERRSCNT)_" occurred during FILE^DIE.",15)
+25 ;
+26 QUIT
+27 ;
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 ;
CHKOERRO(LRODT,LRSP) ; EP - Delete invalid OERR #'s at the Order level
+1 NEW ERRS,FDA,OERRNUM
+2 ;
+3 SET OERRNUM=+$PIECE($GET(^LRO(69,LRODT,1,LRSP,0)),U,11)
+4 ; If no OERR number, skip
IF OERRNUM<1
QUIT
+5 ; Skip if OERR # valid
IF +$GET(^OR(100,OERRNUM,0))
QUIT
+6 ;
+7 SET BADCNT=BADCNT+1
+8 SET BADOCNT=BADOCNT+1
+9 KILL FDA,ERRS
+10 SET FDA(69.01,LRSP_","_LRODT_",",.11)="@"
+11 DO FILE^DIE("KS","FDA","ERRS")
+12 ;
+13 IF $DATA(ERRS)<1
SET DELCNT=DELCNT+1
QUIT
+14 ;
+15 DO SAVERRS(.FDA,.ERRS,"Order OERR Number Error.")
+16 QUIT
+17 ;
CHKOERRT(LRODT,LRSP,LROT) ; EP - Delete invalid OERR #'s at the Test level
+1 NEW ERRS,FDA,OERRNUM
+2 ;
+3 SET OERRNUM=+$PIECE($GET(^LRO(69,LRODT,1,LRSP,2,LROT,0)),U,7)
+4 ; If no OERR number, skip
IF OERRNUM<1
QUIT
+5 ; Skip if OERR # valid
IF +$GET(^OR(100,OERRNUM,0))
QUIT
+6 ;
+7 SET BADCNT=BADCNT+1
+8 SET BADTCNT=BADTCNT+1
+9 KILL FDA,ERRS
+10 SET FDA(69.03,LROT_","_LRSP_","_LRODT_",",6)="@"
+11 DO FILE^DIE("KS","FDA","ERRS")
+12 ;
+13 IF $DATA(ERRS)<1
SET DELCNT=DELCNT+1
QUIT
+14 ;
+15 DO SAVERRS(.FDA,.ERRS,"Test OERR Number Error.")
SET ERRSCNT=ERRSCNT+1
+16 QUIT
+17 ;
SAVERRS(FDA,ERR,MSG) ; EP
+1 NEW DAYSPURG,NOW
+2 ;
+3 SET DAYSPURG=$$HTFM^XLFDT(+$HOROLOG+180)
+4 IF $PIECE($GET(^XTMP("BLRPRE35",0)),U)<DAYSPURG
SET ^XTMP("BLRPRE35",0)=DAYSPURG_U_DT_U_"LR*5.2*1035"
+5 IF $GET(^XTMP("BLRPRE35","69"))'["BLR35PST Routine."
SET ^XTMP("BLRPRE35","69")="BLR35PST Routine. Lab Order Entry Anamolies"_U_DT
+6 SET NOW=$HOROLOG
+7 MERGE ^XTMP("BLRPRE35","69",NOW,"A FDA")=FDA
+8 MERGE ^XTMP("BLRPRE35","69",NOW,"B ERRS")=ERRS
+9 SET ^XTMP("BLRPRE35","69",NOW,"C MSG")=MSG
+10 QUIT
+11 ;
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
