Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLR35PST

BLR35PST.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EEP ; EP - Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. PEP ; EP
  1. POST ; EP - POST INSTALL
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S QUIET=1
  1.  ;
  1. POSTDBG ; EP - POST INSTALL for DEBUG
  1.  ;
  1.  D SETEVARS
  1.  ;
  1.  S TODAY=$$DT^XLFDT
  1.  S WOTCNT=$$WOTCNT(BLRVERN)
  1.  ;
  1.  D BMES^XPDUTL(CPSTR_" Post Install"),BLANK
  1.  ;
  1.  D NOSNAPS^BLRKIDS2(QUIET)   ; Make sure TAKE SNAPSHOTS field in BLR MASTER CONTROL is OFF
  1.  D LABJRNL              ; Get rid of extraneous LAB JOURNAL pointers in file 61.2
  1.  D OERRSTSC^BLR7OB1     ; Change Any Order's deleted test's OERR Status from PENDING (LR*5.2*1033 Bug)
  1.  D NOPCEON              ; Make sure LABORATORY SITE (#69.9) file's PCE/VSIT ON field is OFF
  1.  D CLEANUP              ; Make sure ^BLRENTRY global is Reset
  1.  D BADOERRC             ; Clean up BAD OE/RR Numbers in File 69
  1.  ;
  1.  D ENDINSTL(CP),BLANK
  1.  ;
  1.  D BMES^XPDUTL("Laboratory Patch "_CPSTR_" INSTALL complete.")
  1.  ;
  1.  Q:+$G(DEBUG)
  1.  ;
  1.  D POSTMAIL(BLRVERN,CPSTR)
  1.  ;
  1.  S ^XTMP(BLRVERN,TODAY,WOTCNT,"END")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1. ADDNOPTS ; EP - ADD New OPTionS
  1.  Q:$G(DEBUG)
  1.  ;
  1.  S TAB=$G(TAB,$J("",5))
  1.  ;
  1.  D NEWOPT("BLRMENU","BLR PURGE ALERTS","PURG",90)     ; Purge Alerts
  1.  D NEWOPT("BLRMENU","BLRGUIER","GUIR")                ; Lab GUI Accession Reports
  1.  D NEWOPT("BLRMENU","BLRLROS","LROS")                 ; RPMS Lab Order/Test Status
  1.  D NEWOPT("BLRMENU","BLRHLMIR","MONJ")                ; Monitor Jobs & HLZTCP
  1.  D NEWOPT("LRSUPERVISOR","BLR Parameter Utilities","EPAR") ; Edit IHS Laboratory XPAR Parameters
  1.  ;
  1.  Q
  1.  ;
  1. NEWOPT(MENU,NEWOPTN,NEWSYNM,NEWORD) ; EP - Add Option to a Menu
  1.  NEW BLRIEN,TAB
  1.  ;
  1.  S TAB=$J("",5)
  1.  ;
  1.  S BLRIEN=$$LKOPT^XPDMENU(MENU)
  1.  Q:$$FIND1^DIC(19.01,","_BLRIEN_",",,NEWSYNM,"C")    ; Don't add if already on MENU
  1.  ;
  1.  D BMES^XPDUTL("Adding '"_NEWOPTN_"' option to "_MENU_".")
  1.  ;
  1.  S X=$$ADD^XPDMENU(MENU,NEWOPTN,NEWSYNM,$G(NEWORD,""))
  1.  ;
  1.  I X=1 D MES^XPDUTL(TAB_"'"_NEWOPTN_"' added to "_MENU_". OK."),BLANK  Q
  1.  ;
  1.  D MES^XPDUTL(TAB_"Error in adding '"_NEWOPTN_"' option to "_MENU_".")
  1.  D MES^XPDUTL(TAB_TAB_"Error Message: "_$$UP^XLFSTR($P(X,"^",2))),BLANK
  1.  ;
  1.  Q
  1.  ;
  1. POSTMAIL(BLRVERN,CPSTR) ; EP - Post Install MailMan Message
  1.  NEW STR
  1.  ;
  1.  S STR(1)=" "
  1.  S STR(2)=$J("",10)_"POST INSTALL of "_BLRVERN_" Routine."
  1.  S STR(3)=" "
  1.  S STR(4)=$J("",15)_"Laboratory Patch "_CPSTR_" INSTALL completed."
  1.  S STR(5)=" "
  1.  ;
  1.  Q:+$G(DEBUG)   ; No MailMan messages during debugging
  1.  ;
  1.  ; Send E-Mail to LMI Mail Group & Installer
  1.  D MAILALMI^BLRUTIL3("Laboratory Patch "_CPSTR_" INSTALL complete.",.STR,BLRVERN)
  1.  ;
  1.  Q
  1.  ;
  1. 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)
  1.  ;
  1.  Q:+$O(^LAB(95,0))      ; If there is no data in file 95, don't do anything
  1.  ;
  1.  S CNT=0,IEN=.9999999
  1.  F  S IEN=$O(^LAB(61.2,IEN))  Q:IEN<1  D
  1.  . S JOURN=0  F  S JOURN=$O(^LAB(61.2,IEN,"JR",JOURN))  Q:JOURN<1  D
  1.  .. S CNT=CNT+1
  1.  .. I CNT=1 D
  1.  ... S ^XTMP("LABJOURNL",0)=$$HTFM^XLFDT(+$H+365)_"^"_$$DT^XLFDT_"^Entries In File 61.2 that Pointed to (Empty) File 95"
  1.  .. S ^XTMP("LABJOURNL","61.2","IEN",IEN)=""
  1.  .. M ^XTMP("LABJOURNL","61.2","IEN",IEN,"JOURN",JOURN)=^LAB(61.2,IEN,"JR",JOURN)
  1.  .. ;
  1.  .. K DA
  1.  .. S DA(1)=IEN,DA=JOURN
  1.  .. S DIK="^LAB(61.2,"_DA(1)_",""JR"","
  1.  .. D ^DIK
  1.  ;
  1.  S:CNT ^XTMP("LABJOURNL","61.2")=CNT
  1.  Q
  1.  ;
  1.  ; ========================= UTILITIES FOLLOW ==========================
  1.  ;
  1. SETEVARS ; EP - SET standard "Enviroment" VARiables.
  1.  S (CP,PATCHNUM)=$P($T(+2),"*",3)
  1.  S CPSTR="LR*5.2*"_CP
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  Q
  1.  ;
  1. BLANK ; EP - Blank Line
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. MESCNTR(STR) ; EP - Center a line and use XPDUTL to display it
  1.  D MES^XPDUTL($$CJ^XLFSTR(STR,IOM))
  1.  Q
  1.  ;
  1. WOTCNT(BLRVERN) ; EP - Counter for ^XTMP
  1.  NEW CNT,TODAY
  1.  ;
  1.  S TODAY=$$DT^XLFDT
  1.  ;
  1.  S CNT=1+$G(^XTMP(BLRVERN,0,TODAY))
  1.  S ^XTMP(BLRVERN,0,TODAY)=CNT
  1.  Q $TR($J(CNT,3)," ","0")
  1.  ;
  1. INITSCR ; EP - Initialize screen. Cloned from INIT^XPDID
  1.  N X,XPDSTR
  1.  I IO'=IO(0)!(IOST'["C-VT") S XPDIDVT=0 Q
  1.  I $T(PREP^XGF)="" S XPDIDVT=0 Q
  1.  D PREP^XGF
  1.  S XPDIDVT=1,X="IOSTBM",XPDSTR=""
  1.  D ENDR^%ZISS
  1.  S IOTM=3,IOBM=IOSL-4
  1.  W @IOSTBM
  1.  D FRAME^XGF(IOTM-2,0,IOTM-2,IOM-1) ; Top line
  1.  ; D FRAME^XGF(IOBM+1,0,IOBM+1,IOM-1) ; Bottom line
  1.  D IOXY^XGF(IOTM-2,0)
  1.  Q
  1.  ;
  1. 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)
  1.  ;
  1.  ; NOTE: DEBUG will not store "Backup" data.
  1.  ;
  1.  D SETEVARS
  1.  ;
  1.  W !!
  1.  W "Debug Routine ",BLRVERN," Begins:",!!
  1.  ;
  1.  ; Note -- DEBUG is a negative flag:
  1.  ;         1="Don't Send Alerts"; 0="Send Alerts"
  1.  ;
  1.  ; D ^XBFMK
  1.  ; S DIR(0)="YO"
  1.  ; S DIR("B")="NO"
  1.  ; S DIR("A")="Send Alerts/E-Mails"
  1.  ; D ^DIR
  1.  ; S:+$G(Y)=1 DEBUGA="YES"
  1.  ;
  1.  S DEBUG=1      ; At this time, DO NOT ASK -- just DO NOT send alerts
  1.  ;
  1.  W !
  1.  S XPDNM=CPSTR
  1.  S XPDENV=0
  1.  ;
  1.  D ENVICHEK^BLRPRE35
  1.  D PRESSKEY^BLRGMENU(4)
  1.  ;
  1.  Q:XPDABORT
  1.  ;
  1.  D PRE^BLRPRE35
  1.  W !!!
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="YO"
  1.  S DIR("B")="NO"
  1.  S DIR("A")="Test Post Install Code"
  1.  D ^DIR
  1.  ;
  1.  S QUIET=0
  1.  D:+$G(Y)=1 POSTDBG
  1.  ;
  1.  W !!,"Debug Routine ",BLRVERN," Ends.",!!
  1.  Q
  1.  ;
  1. CHKBCKUP ; EP - Check to determine if BACKUP has been performed.
  1.  NEW CP                       ; Current Patch
  1.  S CP=$TR($P($T(+2),";",5),"*")
  1.  ;
  1.  D PASSMESG^BLRPRE31("ATTENTION")
  1.  W !
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="Y"
  1.  S DIR("B")="NO"
  1.  S DIR("A")=$J("",10)_"Has a >> SUCCESSFUL << backup been performed?"
  1.  D ^DIR
  1.  W !
  1.  ;
  1.  I +$G(Y)'=1 D  Q    ; If BACKUP not performed, then ABORT installation.
  1.  . S XPDABORT=1
  1.  . D PASSMESG^BLRPRE31("ATTENTION")
  1.  . D BMES^XPDUTL($J("",15)_"SUCCESSFUL system backup has >>> NOT <<< been confirmed.")
  1.  . D BMES^XPDUTL($J("",25)_"Installer: "_$$GET1^DIQ(200,DUZ,"NAME")_" ["_DUZ_"].")
  1.  . D BMES^XPDUTL($J("",15)_"Install Aborting.")
  1.  . H 1   ; Pause 1 second to let the user see the message.
  1.  ;
  1.  ; Store backup confirmation person & date/time
  1.  S BCKUPCNT=1+$O(^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",""),-1)
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT)=DUZ_"^"_$P($G(^VA(200,DUZ,0)),U)
  1.  S ^BLRINSTL("LAB PATCH",CP,"BACKUP CONFIRMED BY",BCKUPCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5MZ")
  1.  ;
  1.  D BOKAY^BLRKIDS2("SUCCESSFUL system backup CONFIRMED by: "_$$GET1^DIQ(200,DUZ,"NAME")_".",5)
  1.  H 1     ; Pause 1 second to let the user see the message.
  1.  Q
  1.  ;
  1. ENDINSTL(CURPATCH) ; EP - End Installation
  1.  NEW INSTCNT            ; Installation count
  1.  ;
  1.  S INSTCNT=1+$O(^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",""),-1)
  1.  ;
  1.  S ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT)=DUZ_"^"_$$GET1^DIQ(200,DUZ,"NAME")
  1.  S ^BLRINSTL("LAB PATCH",CURPATCH,"INSTALLED BY",INSTCNT,"DATE/TIME")=$$HTE^XLFDT($H,"5Z")
  1.  Q
  1.  ;
  1. NOPCEON ; EP - Ensure LABORATORY SITE (#69.9) file's PCE VISIT ON field is OFF if PCE not installed.
  1.  NEW FDA,ERRS
  1.  ;
  1.  Q:+$$PATCH^BLRUTIL4("PX*1.0*200")     ; Skip if PCE is installed.
  1.  ;
  1.  ; PCE not installed.
  1.  S FDA(69.9,"1,",615)=0
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  I $D(ERRS)<1 D  Q
  1.  . D BOKAY^BLRKIDS2("LABORATORY SITE (#69.9) file's PCE VISIT ON field is OFF.",5)
  1.  ;
  1.  D BMES^XPDUTL("LABORATORY SITE (#69.9) file's PCE VISIT ON field was NOT set to OFF.")
  1.  Q
  1.  ;
  1. CLEANUP ; EP - Ensure ^BLRENTRY global is purged
  1.  NEW DEBUGGLO
  1.  ;
  1.  Q:$D(^BLRENTRY)<1      ; Skip if ^BLRENTRY is null
  1.  ;
  1.  S DEBUGGLO="^BLRENTRY"
  1.  K @DEBUGGLO
  1.  Q
  1.  ;
  1. 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)
  1.  ;
  1.  D BMES^XPDUTL("Lab Order Entry (#69) File Analysis.")
  1.  S LRODT=.9999999,(BADCNT,BADOCNT,BADTCNT,CNT,DELCNT,ERRSCNT,ORDCNT)=0
  1.  W ?4
  1.  F  S LRODT=$O(^LRO(69,LRODT))  Q:LRODT<1  D
  1.  . S LRSP=0
  1.  . F  S LRSP=$O(^LRO(69,LRODT,1,LRSP))  Q:LRSP<1  D
  1.  .. D WARMFZZY(.ORDCNT)
  1.  .. D CHKOERRO(LRODT,LRSP)
  1.  .. S LROT=0
  1.  .. F  S LROT=$O(^LRO(69,LRODT,1,LRSP,2,LROT))  Q:LROT<1  D
  1.  ... D CHKOERRT(LRODT,LRSP,LROT)
  1.  ;
  1.  W:$X>4 !
  1.  ;
  1.  D BOKAY^BLRKIDS2(ORDCNT_" Orders analyzed.",5)
  1.  I BADCNT<1 D TABMENU^BLRKIDSU(" No anomalies detected.",10)  Q
  1.  ;
  1.  D:BADCNT TABMENU^BLRKIDSU(BADCNT_" Bad Entr"_$$PLURALI^BLRUTIL7(BADCNT)_".",10)
  1.  D:BADOCNT TABMENU^BLRKIDSU(BADOCNT_"Bad Entr"_$$PLURALI^BLRUTIL7(BADOCNT)_" at the Order Level.",15)
  1.  D:BADTCNT TABMENU^BLRKIDSU(BADOCNT_"Bad Entr"_$$PLURALI^BLRUTIL7(BADTCNT)_" at the Test Level.",15)
  1.  D:DELCNT TABMENU^BLRKIDSU(DELCNT_" Bad Entr"_$$PLURALI^BLRUTIL7(DELCNT)_" Deleted.",10)
  1.  D:ERRSCNT TABMENU^BLRKIDSU(ERRSCNT_" Error"_$$PLURAL^BLRUTIL7(ERRSCNT)_" occurred during FILE^DIE.",15)
  1.  ;
  1.  Q
  1.  ;
  1. WARMFZZY(ORDCNT) ; EP - "Warm Fuzzy" for user
  1.  S ORDCNT=ORDCNT+1
  1.  W:(ORDCNT#1000)=0 "."
  1.  W:$X>74 !,?4
  1.  Q
  1.  ;
  1. CHKOERRO(LRODT,LRSP) ; EP - Delete invalid OERR #'s at the Order level
  1.  NEW ERRS,FDA,OERRNUM
  1.  ;
  1.  S OERRNUM=+$P($G(^LRO(69,LRODT,1,LRSP,0)),U,11)
  1.  Q:OERRNUM<1                 ; If no OERR number, skip
  1.  Q:+$G(^OR(100,OERRNUM,0))   ; Skip if OERR # valid
  1.  ;
  1.  S BADCNT=BADCNT+1
  1.  S BADOCNT=BADOCNT+1
  1.  K FDA,ERRS
  1.  S FDA(69.01,LRSP_","_LRODT_",",.11)="@"
  1.  D FILE^DIE("KS","FDA","ERRS")
  1.  ;
  1.  I $D(ERRS)<1 S DELCNT=DELCNT+1  Q
  1.  ;
  1.  D SAVERRS(.FDA,.ERRS,"Order OERR Number Error.")
  1.  Q
  1.  ;
  1. CHKOERRT(LRODT,LRSP,LROT) ; EP - Delete invalid OERR #'s at the Test level
  1.  NEW ERRS,FDA,OERRNUM
  1.  ;
  1.  S OERRNUM=+$P($G(^LRO(69,LRODT,1,LRSP,2,LROT,0)),U,7)
  1.  Q:OERRNUM<1                 ; If no OERR number, skip
  1.  Q:+$G(^OR(100,OERRNUM,0))   ; Skip if OERR # valid
  1.  ;
  1.  S BADCNT=BADCNT+1
  1.  S BADTCNT=BADTCNT+1
  1.  K FDA,ERRS
  1.  S FDA(69.03,LROT_","_LRSP_","_LRODT_",",6)="@"
  1.  D FILE^DIE("KS","FDA","ERRS")
  1.  ;
  1.  I $D(ERRS)<1 S DELCNT=DELCNT+1  Q
  1.  ;
  1.  D SAVERRS(.FDA,.ERRS,"Test OERR Number Error.")  S ERRSCNT=ERRSCNT+1
  1.  Q
  1.  ;
  1. SAVERRS(FDA,ERR,MSG) ; EP
  1.  NEW DAYSPURG,NOW
  1.  ;
  1.  S DAYSPURG=$$HTFM^XLFDT(+$H+180)
  1.  S:$P($G(^XTMP("BLRPRE35",0)),U)<DAYSPURG ^XTMP("BLRPRE35",0)=DAYSPURG_U_DT_U_"LR*5.2*1035"
  1.  S:$G(^XTMP("BLRPRE35","69"))'["BLR35PST Routine." ^XTMP("BLRPRE35","69")="BLR35PST Routine.  Lab Order Entry Anamolies"_U_DT
  1.  S NOW=$H
  1.  M ^XTMP("BLRPRE35","69",NOW,"A FDA")=FDA
  1.  M ^XTMP("BLRPRE35","69",NOW,"B ERRS")=ERRS
  1.  S ^XTMP("BLRPRE35","69",NOW,"C MSG")=MSG
  1.  Q
  1.  ;
  1. 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)
  1.  ;
  1.  S BL=$G(BL,0)
  1.  D:BL BMES^XPDUTL(MSG)
  1.  D:'BL MES^XPDUTL(MSG)
  1.  ;
  1.  ; Write message into the INSTALL file
  1.  S IEN=$O(^XPD(9.7,"B",CP,"A"),-1)  ; Get Patch IEN
  1.  ;
  1.  S LINE=$O(^XPD(9.7,IEN,"MES","A"),-1)+1
  1.  I BL S ^XPD(9.7,IEN,"MES",LINE,0)=" "  S LINE=LINE+1
  1.  S ^XPD(9.7,IEN,"MES",LINE,0)=MSG
  1.  Q