LR343 ;VA/DALOI/JDB - LR*5.2*343 KIDS ROUTINE
;;5.2;LAB SERVICE;**1031**;NOV 01, 1997
;
;;VA LR Patche(s): 343
;
;
; Send email if #69.9 fields set to Yes
; Set LR7O MOVEMENT EVENT protocols DISABLE and ACTION fields
; Pause X minutes so any running protocols can clear
; KIDS deletes LR7OEVNT routine
; KIDS deletes LR7O MOVEMENT EVENT protocols
; Delete data from #69.9 fields
; Delete #69.9 fields DD
;
;
EN ;
; Environment Check
; Does not prevent loading of the transport global.
;
D BMES^XPDUTL($$CJ^XLFSTR("--- Environment check of patch "_$G(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($H)_" ---",IOM)) ; IHS/MSC/MKK
;
D CLEAN
D CHECK
I $G(XPDQUIT) D Q ;
. ; W !,$$CJ^XLFSTR("Environment check failed",$G(IOM,80))
. D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check for "_$G(XPDNM,"Unknown patch")_" FAILED ---",80)) ; IHS/MSC/MKK
;
; W !,$$CJ^XLFSTR("Environment is okay",$G(IOM,80))
D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check for "_$G(XPDNM,"Unknown patch")_" is okay ---",80)) ; IHS/MSC/MKK
;
D ALERT("Installation of patch "_$G(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($H))
I '$G(XPDENV) D Q
. D ALERT("Transport global for patch "_$G(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($H))
. ; D MSGADD("Sending transport global loaded alert to mail group G.LMI")
Q
;
CHECK ;
; Perform environment check
N POP
; Is Home device defined
; Need Home device so "task install" option is displayed
S POP=0 S IOP="",%ZIS=0 D ^%ZIS
I POP D Q
. S XPDQUIT=2
. W !,$$CJ^XLFSTR("*** Home device is not defined ***",$G(IOM,80))
;
; Device Defined
I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D Q
. W !,$$CJ^XLFSTR("*** Terminal Device is not defined ***",$G(IOM,80))
. S XPDQUIT=2
;
; DUZ setup
I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D Q
. W !,$$CJ^XLFSTR("*** Please log in to set variables ***",$G(IOM,80))
. S XPDQUIT=2
;
; Active User
I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D Q
. W !,$$CJ^XLFSTR("*** You are not a valid user on this system ***",$G(IOM,80))
. S XPDQUIT=2
;
; KIDS default answer to "Disable Protocols...."
S XPDDIQ("XPZ1")=0 ;;Dont allow disabling options
S XPDDIQ("XPZ1","B")="NO"
Q
;
PRE ;
; KIDS Pre Install
; Check that install was tasked
; Check if any File #69.9 fields are set to "YES" If so send
; notification email.
; Disable Lab Protocols (set DISABLED field and set ACTION to Q)
; Hang so current processes started by protocols can end
N IEN,ERR,PREERR,RECIPS,BODY,VALS,STR
S PREERR=0
D MSGADD("Pre install started at "_$$HTE^XLFDT($H))
;
; Was install tasked? Quit if not
; ----- BEGIN IHS/MSC/MKK
; Cannot be tasked -- part of an IHS Lab Patch multi-Build.
; Check for Queued status will be skipped.
; ----- END IHS/MSC/MKK
; I '$D(ZTQUEUED) I $G(IO("Q"))="" D Q
; . S XPDQUIT=2
; . S XPDABORT=2
; . D MSGADD("*** THIS INSTALLATION MUST BE TASKED ***")
; . D MSGADD("",0)
; . D MSGADD("Refer to the Patch Installation instructions",0)
; . D MSGADD("for details concerning re-running the install.",0)
; . D CLEAN
;
; check DD field values and send email if any are YES
S VALS=$$GETVALS()
I VALS>0 D ;
. S STR="File #69.9 LABORATORY SITE has one or more fields that were set to YES."
. D BLDBODY(STR,.BODY)
. S STR=" #150.3 CANCEL ON ADMIT set to "_$S($E(VALS,1,1):"YES",1:"NO")
. D BLDBODY(STR,.BODY)
. S STR=" #150.4 CANCEL ON DISCHARGE set to "_$S($E(VALS,2,2):"YES",1:"NO")
. D BLDBODY(STR,.BODY)
. S STR=" #150.5 CANCEL ON SPECIALTY set to "_$S($E(VALS,3,3):"YES",1:"NO")
. D BLDBODY(STR,.BODY)
. D BLDBODY(" ",.BODY)
. S STR="One or more DC fields of File #69.9 are set to Yes. These fields should have been set to No according to guidelines issued with the release of OR*3*142 and OR*3*141."
. S STR=STR_" Facilities would be advised to use the functionality provided in file #100.6 (released with OR*3*142) to maintain the ability to auto discontinue laboratory orders upon a patient movement."
. S STR=STR_" Please check your configurations to ensure that this migration has occurred."
. D BLDBODY(STR,.BODY)
. S RECIPS(DUZ)=""
. S RECIPS("G.LMI")=""
. D EMAIL("LR*5.2*343 -- 69.9 DC Fields","BODY",.RECIPS)
. K BODY
. D MSGADD("*** File #69.9 field(s) set to YES ***")
;
D ALERT("LR*5.2*343 Installation has started")
; D MSGADD("Sent install started alert to mail group G.LMI")
;
; Disable Protocols and set action event to quit
D MSGADD("Setting DISABLE and ACTION fields for Protocols")
S IEN=$$FIND1^DIC(101,,"XO","LR7O MOVEMENT EVENT","B",,"ERR")
I IEN D UPDTPROT(IEN)
I 'IEN D MSGADD("*** Did not find LR7O MOVEMENT EVENT PROTOCOL ***")
S IEN=$$FIND1^DIC(101,,"XO","LR7O MOVEMENT EVENT TASK","B",,"ERR")
I IEN D UPDTPROT(IEN)
I 'IEN D MSGADD("*** Did not find LR7O MOVEMENT EVENT TASK PROTOCOL ***")
;
; Now hang for X minutes to let all existing triggered
; events to clear so we don't cause any "cant return to source"
; errors when we overwrite the protocl's routine which would
; cause the other chained events not to be processed (the hang is
; why the install is tasked and not run in direct mode)
;
; ----- BEGIN IHS/MSC/MKK
; Notes above about Tasked install are VA notes.
; This install is not tasked becuase it's part of a mega-build.
; Just pause 5 minutes after giving Installer message.
D BIGHONK
; ----- END IHS/MSC/MKK
;
H 300 ; Pause 5 Minutes
;
I 'PREERR D MSGADD("No actions required for pre install")
D MSGADD("Pre install completed at "_$$HTE^XLFDT($H))
Q
;
POST ;
; KIDS Post Install
; Delete data in File #69.9 fields
; Remove #69.9 fields from Data Dictionary
; Email installation progress message
N DA,DIK,LRFDA,LRMSG,LRMSG2,POSTERR,RECIPS
S POSTERR=0
D MSGADD("Post install started at "_$$HTE^XLFDT($H))
D MSGADD("File #69.9 field data update started")
; delete #69.9 field data
S LRFDA(1,69.9,"1,",150.3)="@"
S LRFDA(1,69.9,"1,",150.4)="@"
S LRFDA(1,69.9,"1,",150.5)="@"
K MSG
D FILE^DIE("","LRFDA(1)","LRMSG")
I $D(LRMSG) D ;
. K LRMSG2
. D MSG^DIALOG("ASEM",.LRMSG2,$G(IOM,80),,"LRMSG")
. ; S POSTERR=1
. D MSGADD(.LRMSG2)
D KILLDD(150.3)
D KILLDD(150.4)
D KILLDD(150.5)
D MSGADD("File #69.9 field data deletion finished")
D MSGADD("Post install completed"_$S(POSTERR:" with errors",1:"")_" at "_$$HTE^XLFDT($H))
; D MSGADD("Sending install completion alert to mail group G.LMI")
; Send alert
D ALERT("Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)_$S(POSTERR:" with errors",1:""))
S RECIPS(DUZ)=""
D EMAIL("INSTALL COMPLETED:"_$G(XPDNM),"^TMP(""LR343"","_$J_",""MSG"")",.RECIPS)
D CLEAN
Q
;
ALERT(MSG) ;
N DA,DIK,XQA,XQAMSG
S MSG=$G(MSG)
S XQAMSG=MSG
S XQA("G.LMI")=""
; D SETUP^XQALERT ; IHS/MSC/MKK
Q
;
EMAIL(SUB,LRTXT,LRADDR) ;
; Sends an email message via MailMan using installer's DUZ
; SUB <byval> Subject for the message
; LRTXT <byval> Closed root local or global array
; ie local array TEXT(1) passed as "TEXT"
; LRADDR <byref> MailMan compatable array of message recipients
N XMERR,XMZ,DIFROM
; D SENDMSG^XMXAPI($G(DUZ),$G(SUB),$G(LRTXT),.LRADDR)
Q $G(XMZ,-1)
;
BLDBODY(STR,ARR) ;
; Adds a string to the end of the passed array
; Useful for building email message bodies
; STR <req> The string to add to the array
; ARR <byref> The array. Should be a simple, integer
; based subscript array ie X(1), X(2), etc.
N SUB
S STR=$G(STR)
S SUB=+$O(ARR("A"),-1)
S ARR(SUB+1)=STR
Q
;
GETVALS(NULL) ;
; Returns the values for #69.9 fields 150.3,150.4,150.5
; as a string ie 000 or 010 etc (each field is only 1 or 0)
N NODE,LRDATA,LRERR,VALUES
S VALUES=""
D GETS^DIQ(69.9,"1,","150.3;150.4;150.5","I","LRDATA","LRERR")
I $D(LRDATA(69.9))>9 D ;
. S NODE="LRDATA(69.9)"
. F S NODE=$Q(@NODE) Q:NODE="" Q:$QS(NODE,1)'=69.9 S VALUES=VALUES_+@NODE
Q VALUES
;
UPDTPROT(IEN) ;
; Sets the PROTOCOL's (#101) DISABLE field (#2) to DISABLED
; and its ENTRY ACTION field (#20) to Q (QUIT)
N LRFDA,LRMSG
S IEN=$G(IEN)
S LRFDA(1,101,IEN_",",2)="DISABLED BY LR*5.2*343"
S LRFDA(1,101,IEN_",",20)="Q"
D FILE^DIE("ET","LRFDA(1)","LRMSG")
Q
;
MSGADD(TXT,LB) ;
; Utility to create a message global to save install
; messages and send later, usually via mailman. Useful
; when an install is tasked. It will print
; the messages out as they come in, as well as save them
; to the TMP global
; Input
; TXT <byref or byval>
; If $D(TXT)=1 then TXT is saved
; If $D(TXT)>9 then step through array and save each node
; as separate line.
; LB <opt> LineBreak (True then uses MBES -- False uses MES)
;
; TXT <byref> is used by-ref when passsing in arrays created by
; the FileMan MSG^DIALOG output array
;
N NODE,SUB,POS
S TXT=$G(TXT)
S LB=$G(LB)
I LB="" S LB=1
S LB=+LB
S SUB=+$O(^TMP("LR343",$J,"MSG","A"),-1)
I $D(TXT)>9 D ;
. S NODE="TXT"
. F S NODE=$Q(@NODE) Q:NODE="" D ;
. . S ^TMP("LR343",$J,"MSG",SUB+1)=@NODE
. . S SUB=SUB+1
. . I $D(XPDENV) I LB D BMES^XPDUTL($$CJ^XLFSTR(@NODE,$G(IOM,80)))
. . I $D(XPDENV) I 'LB D MES^XPDUTL($$CJ^XLFSTR(@NODE,$G(IOM,80)))
. . ; I '$D(XPDENV) W !,$$CJ^XLFSTR(@NODE,$G(IOM,80))
. . I '$D(XPDENV) D BMES^XPDUTL($$CJ^XLFSTR(@NODE,$G(IOM,80))) ; IHS/MSC/MKK
. ;
;
I $D(TXT)=1 D ;
. S ^TMP("LR343",$J,"MSG",SUB+1)=TXT
. I '$D(XPDENV) I LB D BMES^XPDUTL($$CJ^XLFSTR(TXT,$G(IOM,80)))
. I '$D(XPDENV) I 'LB D MES^XPDUTL($$CJ^XLFSTR(TXT,$G(IOM,80)))
. ; I $D(XPDENV) W !,$$CJ^XLFSTR(TXT,$G(IOM,80))
. I $D(XPDENV) D BMES^XPDUTL($$CJ^XLFSTR(TXT,$G(IOM,80))) ; IHS/MSC/MKK
Q
;
CLEAN ;
; K ^TMP("LR343",$J)
D CLEAN^DILF
Q
;
KILLDD(FIELD) ;
; Deletes the #69.9 field's DD
N DIK,DA
S DIK="^DD(69.9,"
S DA=FIELD
S DA(1)=69.9
D ^DIK
Q
;
; ---- BEGIN IHS/MSC/MKK - LR*5.2*1031
;
BIGHONK ; EP - Big, Honking Warning Message
D PASSMESG("ATTENTION")
W !
W ?4,"This install must now pause for 5 minutes in order to let all existing",!
W ?4,"events clear so that ""Can't Return To Source"" errors do not occur when",!
W ?4,"the LR70 MOVEMENT EVENT and LR70 MOVEMENT EVENT TASK protocols are",!
W ?4,"modified.",!!
W ?4,"An error would cause the other chained events not to be processed.",!!
W ?4,"Your patience is appreciated. Pause begins NOW at ",$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ")),".",!
Q
;
PASSMESG(WOT) ; EP -- Splash message
NEW CRTLINE,MAXIT,AROUND
;
F CRTLINE=1:1:21 W $J("",80),!
D EN^XBVIDEO("HOM")
S MAXIT="@"
F J=1:1:$L(WOT) S MAXIT=MAXIT_$E(WOT,J,J)_"@"
S AROUND=$TR($J("",8+$L(MAXIT))," ","@")
S MAXIT="@@!!"_$TR(MAXIT," ","@")_"!!@@"
;
W !!
W $TR($J("",IOM)," ","*"),!
W $TR($J("",IOM)," ","*"),!
W $TR($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
W $TR($$CJ^XLFSTR(MAXIT,IOM)," @","* "),!
W $TR($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
W $TR($J("",IOM)," ","*"),!
W $TR($J("",IOM)," ","*"),!
Q
;
; ---- END IHS/MSC/MKK - LR*5.2*1031
LR343 ;VA/DALOI/JDB - LR*5.2*343 KIDS ROUTINE
+1 ;;5.2;LAB SERVICE;**1031**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patche(s): 343
+4 ;
+5 ;
+6 ; Send email if #69.9 fields set to Yes
+7 ; Set LR7O MOVEMENT EVENT protocols DISABLE and ACTION fields
+8 ; Pause X minutes so any running protocols can clear
+9 ; KIDS deletes LR7OEVNT routine
+10 ; KIDS deletes LR7O MOVEMENT EVENT protocols
+11 ; Delete data from #69.9 fields
+12 ; Delete #69.9 fields DD
+13 ;
+14 ;
EN ;
+1 ; Environment Check
+2 ; Does not prevent loading of the transport global.
+3 ;
+4 ; IHS/MSC/MKK
DO BMES^XPDUTL($$CJ^XLFSTR("--- Environment check of patch "_$GET(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($HOROLOG)_" ---",IOM))
+5 ;
+6 DO CLEAN
+7 DO CHECK
+8 ;
IF $GET(XPDQUIT)
Begin DoDot:1
+9 ; W !,$$CJ^XLFSTR("Environment check failed",$G(IOM,80))
+10 ; IHS/MSC/MKK
DO BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check for "_$GET(XPDNM,"Unknown patch")_" FAILED ---",80))
End DoDot:1
QUIT
+11 ;
+12 ; W !,$$CJ^XLFSTR("Environment is okay",$G(IOM,80))
+13 ; IHS/MSC/MKK
DO BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check for "_$GET(XPDNM,"Unknown patch")_" is okay ---",80))
+14 ;
+15 DO ALERT("Installation of patch "_$GET(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($HOROLOG))
+16 IF '$GET(XPDENV)
Begin DoDot:1
+17 DO ALERT("Transport global for patch "_$GET(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($HOROLOG))
+18 ; D MSGADD("Sending transport global loaded alert to mail group G.LMI")
End DoDot:1
QUIT
+19 QUIT
+20 ;
CHECK ;
+1 ; Perform environment check
+2 NEW POP
+3 ; Is Home device defined
+4 ; Need Home device so "task install" option is displayed
+5 SET POP=0
SET IOP=""
SET %ZIS=0
DO ^%ZIS
+6 IF POP
Begin DoDot:1
+7 SET XPDQUIT=2
+8 WRITE !,$$CJ^XLFSTR("*** Home device is not defined ***",$GET(IOM,80))
End DoDot:1
QUIT
+9 ;
+10 ; Device Defined
+11 IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
Begin DoDot:1
+12 WRITE !,$$CJ^XLFSTR("*** Terminal Device is not defined ***",$GET(IOM,80))
+13 SET XPDQUIT=2
End DoDot:1
QUIT
+14 ;
+15 ; DUZ setup
+16 IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
Begin DoDot:1
+17 WRITE !,$$CJ^XLFSTR("*** Please log in to set variables ***",$GET(IOM,80))
+18 SET XPDQUIT=2
End DoDot:1
QUIT
+19 ;
+20 ; Active User
+21 IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1
Begin DoDot:1
+22 WRITE !,$$CJ^XLFSTR("*** You are not a valid user on this system ***",$GET(IOM,80))
+23 SET XPDQUIT=2
End DoDot:1
QUIT
+24 ;
+25 ; KIDS default answer to "Disable Protocols...."
+26 ;;Dont allow disabling options
SET XPDDIQ("XPZ1")=0
+27 SET XPDDIQ("XPZ1","B")="NO"
+28 QUIT
+29 ;
PRE ;
+1 ; KIDS Pre Install
+2 ; Check that install was tasked
+3 ; Check if any File #69.9 fields are set to "YES" If so send
+4 ; notification email.
+5 ; Disable Lab Protocols (set DISABLED field and set ACTION to Q)
+6 ; Hang so current processes started by protocols can end
+7 NEW IEN,ERR,PREERR,RECIPS,BODY,VALS,STR
+8 SET PREERR=0
+9 DO MSGADD("Pre install started at "_$$HTE^XLFDT($HOROLOG))
+10 ;
+11 ; Was install tasked? Quit if not
+12 ; ----- BEGIN IHS/MSC/MKK
+13 ; Cannot be tasked -- part of an IHS Lab Patch multi-Build.
+14 ; Check for Queued status will be skipped.
+15 ; ----- END IHS/MSC/MKK
+16 ; I '$D(ZTQUEUED) I $G(IO("Q"))="" D Q
+17 ; . S XPDQUIT=2
+18 ; . S XPDABORT=2
+19 ; . D MSGADD("*** THIS INSTALLATION MUST BE TASKED ***")
+20 ; . D MSGADD("",0)
+21 ; . D MSGADD("Refer to the Patch Installation instructions",0)
+22 ; . D MSGADD("for details concerning re-running the install.",0)
+23 ; . D CLEAN
+24 ;
+25 ; check DD field values and send email if any are YES
+26 SET VALS=$$GETVALS()
+27 ;
IF VALS>0
Begin DoDot:1
+28 SET STR="File #69.9 LABORATORY SITE has one or more fields that were set to YES."
+29 DO BLDBODY(STR,.BODY)
+30 SET STR=" #150.3 CANCEL ON ADMIT set to "_$SELECT($EXTRACT(VALS,1,1):"YES",1:"NO")
+31 DO BLDBODY(STR,.BODY)
+32 SET STR=" #150.4 CANCEL ON DISCHARGE set to "_$SELECT($EXTRACT(VALS,2,2):"YES",1:"NO")
+33 DO BLDBODY(STR,.BODY)
+34 SET STR=" #150.5 CANCEL ON SPECIALTY set to "_$SELECT($EXTRACT(VALS,3,3):"YES",1:"NO")
+35 DO BLDBODY(STR,.BODY)
+36 DO BLDBODY(" ",.BODY)
+37 SET STR="One or more DC fields of File #69.9 are set to Yes. These fields should have been set to No according to guidelines issued with the release of OR*3*142 and OR*3*141."
+38 SET STR=STR_" Facilities would be advised to use the functionality provided in file #100.6 (released with OR*3*142) to maintain the ability to auto discontinue laboratory orders upon a patient movement."
+39 SET STR=STR_" Please check your configurations to ensure that this migration has occurred."
+40 DO BLDBODY(STR,.BODY)
+41 SET RECIPS(DUZ)=""
+42 SET RECIPS("G.LMI")=""
+43 DO EMAIL("LR*5.2*343 -- 69.9 DC Fields","BODY",.RECIPS)
+44 KILL BODY
+45 DO MSGADD("*** File #69.9 field(s) set to YES ***")
End DoDot:1
+46 ;
+47 DO ALERT("LR*5.2*343 Installation has started")
+48 ; D MSGADD("Sent install started alert to mail group G.LMI")
+49 ;
+50 ; Disable Protocols and set action event to quit
+51 DO MSGADD("Setting DISABLE and ACTION fields for Protocols")
+52 SET IEN=$$FIND1^DIC(101,,"XO","LR7O MOVEMENT EVENT","B",,"ERR")
+53 IF IEN
DO UPDTPROT(IEN)
+54 IF 'IEN
DO MSGADD("*** Did not find LR7O MOVEMENT EVENT PROTOCOL ***")
+55 SET IEN=$$FIND1^DIC(101,,"XO","LR7O MOVEMENT EVENT TASK","B",,"ERR")
+56 IF IEN
DO UPDTPROT(IEN)
+57 IF 'IEN
DO MSGADD("*** Did not find LR7O MOVEMENT EVENT TASK PROTOCOL ***")
+58 ;
+59 ; Now hang for X minutes to let all existing triggered
+60 ; events to clear so we don't cause any "cant return to source"
+61 ; errors when we overwrite the protocl's routine which would
+62 ; cause the other chained events not to be processed (the hang is
+63 ; why the install is tasked and not run in direct mode)
+64 ;
+65 ; ----- BEGIN IHS/MSC/MKK
+66 ; Notes above about Tasked install are VA notes.
+67 ; This install is not tasked becuase it's part of a mega-build.
+68 ; Just pause 5 minutes after giving Installer message.
+69 DO BIGHONK
+70 ; ----- END IHS/MSC/MKK
+71 ;
+72 ; Pause 5 Minutes
HANG 300
+73 ;
+74 IF 'PREERR
DO MSGADD("No actions required for pre install")
+75 DO MSGADD("Pre install completed at "_$$HTE^XLFDT($HOROLOG))
+76 QUIT
+77 ;
POST ;
+1 ; KIDS Post Install
+2 ; Delete data in File #69.9 fields
+3 ; Remove #69.9 fields from Data Dictionary
+4 ; Email installation progress message
+5 NEW DA,DIK,LRFDA,LRMSG,LRMSG2,POSTERR,RECIPS
+6 SET POSTERR=0
+7 DO MSGADD("Post install started at "_$$HTE^XLFDT($HOROLOG))
+8 DO MSGADD("File #69.9 field data update started")
+9 ; delete #69.9 field data
+10 SET LRFDA(1,69.9,"1,",150.3)="@"
+11 SET LRFDA(1,69.9,"1,",150.4)="@"
+12 SET LRFDA(1,69.9,"1,",150.5)="@"
+13 KILL MSG
+14 DO FILE^DIE("","LRFDA(1)","LRMSG")
+15 ;
IF $DATA(LRMSG)
Begin DoDot:1
+16 KILL LRMSG2
+17 DO MSG^DIALOG("ASEM",.LRMSG2,$GET(IOM,80),,"LRMSG")
+18 ; S POSTERR=1
+19 DO MSGADD(.LRMSG2)
End DoDot:1
+20 DO KILLDD(150.3)
+21 DO KILLDD(150.4)
+22 DO KILLDD(150.5)
+23 DO MSGADD("File #69.9 field data deletion finished")
+24 DO MSGADD("Post install completed"_$SELECT(POSTERR:" with errors",1:"")_" at "_$$HTE^XLFDT($HOROLOG))
+25 ; D MSGADD("Sending install completion alert to mail group G.LMI")
+26 ; Send alert
+27 DO ALERT("Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)_$SELECT(POSTERR:" with errors",1:""))
+28 SET RECIPS(DUZ)=""
+29 DO EMAIL("INSTALL COMPLETED:"_$GET(XPDNM),"^TMP(""LR343"","_$JOB_",""MSG"")",.RECIPS)
+30 DO CLEAN
+31 QUIT
+32 ;
ALERT(MSG) ;
+1 NEW DA,DIK,XQA,XQAMSG
+2 SET MSG=$GET(MSG)
+3 SET XQAMSG=MSG
+4 SET XQA("G.LMI")=""
+5 ; D SETUP^XQALERT ; IHS/MSC/MKK
+6 QUIT
+7 ;
EMAIL(SUB,LRTXT,LRADDR) ;
+1 ; Sends an email message via MailMan using installer's DUZ
+2 ; SUB <byval> Subject for the message
+3 ; LRTXT <byval> Closed root local or global array
+4 ; ie local array TEXT(1) passed as "TEXT"
+5 ; LRADDR <byref> MailMan compatable array of message recipients
+6 NEW XMERR,XMZ,DIFROM
+7 ; D SENDMSG^XMXAPI($G(DUZ),$G(SUB),$G(LRTXT),.LRADDR)
+8 QUIT $GET(XMZ,-1)
+9 ;
BLDBODY(STR,ARR) ;
+1 ; Adds a string to the end of the passed array
+2 ; Useful for building email message bodies
+3 ; STR <req> The string to add to the array
+4 ; ARR <byref> The array. Should be a simple, integer
+5 ; based subscript array ie X(1), X(2), etc.
+6 NEW SUB
+7 SET STR=$GET(STR)
+8 SET SUB=+$ORDER(ARR("A"),-1)
+9 SET ARR(SUB+1)=STR
+10 QUIT
+11 ;
GETVALS(NULL) ;
+1 ; Returns the values for #69.9 fields 150.3,150.4,150.5
+2 ; as a string ie 000 or 010 etc (each field is only 1 or 0)
+3 NEW NODE,LRDATA,LRERR,VALUES
+4 SET VALUES=""
+5 DO GETS^DIQ(69.9,"1,","150.3;150.4;150.5","I","LRDATA","LRERR")
+6 ;
IF $DATA(LRDATA(69.9))>9
Begin DoDot:1
+7 SET NODE="LRDATA(69.9)"
+8 FOR
SET NODE=$QUERY(@NODE)
IF NODE=""
QUIT
IF $QSUBSCRIPT(NODE,1)'=69.9
QUIT
SET VALUES=VALUES_+@NODE
End DoDot:1
+9 QUIT VALUES
+10 ;
UPDTPROT(IEN) ;
+1 ; Sets the PROTOCOL's (#101) DISABLE field (#2) to DISABLED
+2 ; and its ENTRY ACTION field (#20) to Q (QUIT)
+3 NEW LRFDA,LRMSG
+4 SET IEN=$GET(IEN)
+5 SET LRFDA(1,101,IEN_",",2)="DISABLED BY LR*5.2*343"
+6 SET LRFDA(1,101,IEN_",",20)="Q"
+7 DO FILE^DIE("ET","LRFDA(1)","LRMSG")
+8 QUIT
+9 ;
MSGADD(TXT,LB) ;
+1 ; Utility to create a message global to save install
+2 ; messages and send later, usually via mailman. Useful
+3 ; when an install is tasked. It will print
+4 ; the messages out as they come in, as well as save them
+5 ; to the TMP global
+6 ; Input
+7 ; TXT <byref or byval>
+8 ; If $D(TXT)=1 then TXT is saved
+9 ; If $D(TXT)>9 then step through array and save each node
+10 ; as separate line.
+11 ; LB <opt> LineBreak (True then uses MBES -- False uses MES)
+12 ;
+13 ; TXT <byref> is used by-ref when passsing in arrays created by
+14 ; the FileMan MSG^DIALOG output array
+15 ;
+16 NEW NODE,SUB,POS
+17 SET TXT=$GET(TXT)
+18 SET LB=$GET(LB)
+19 IF LB=""
SET LB=1
+20 SET LB=+LB
+21 SET SUB=+$ORDER(^TMP("LR343",$JOB,"MSG","A"),-1)
+22 ;
IF $DATA(TXT)>9
Begin DoDot:1
+23 SET NODE="TXT"
+24 ;
FOR
SET NODE=$QUERY(@NODE)
IF NODE=""
QUIT
Begin DoDot:2
+25 SET ^TMP("LR343",$JOB,"MSG",SUB+1)=@NODE
+26 SET SUB=SUB+1
+27 IF $DATA(XPDENV)
IF LB
DO BMES^XPDUTL($$CJ^XLFSTR(@NODE,$GET(IOM,80)))
+28 IF $DATA(XPDENV)
IF 'LB
DO MES^XPDUTL($$CJ^XLFSTR(@NODE,$GET(IOM,80)))
+29 ; I '$D(XPDENV) W !,$$CJ^XLFSTR(@NODE,$G(IOM,80))
+30 ; IHS/MSC/MKK
IF '$DATA(XPDENV)
DO BMES^XPDUTL($$CJ^XLFSTR(@NODE,$GET(IOM,80)))
End DoDot:2
+31 ;
End DoDot:1
+32 ;
+33 ;
IF $DATA(TXT)=1
Begin DoDot:1
+34 SET ^TMP("LR343",$JOB,"MSG",SUB+1)=TXT
+35 IF '$DATA(XPDENV)
IF LB
DO BMES^XPDUTL($$CJ^XLFSTR(TXT,$GET(IOM,80)))
+36 IF '$DATA(XPDENV)
IF 'LB
DO MES^XPDUTL($$CJ^XLFSTR(TXT,$GET(IOM,80)))
+37 ; I $D(XPDENV) W !,$$CJ^XLFSTR(TXT,$G(IOM,80))
+38 ; IHS/MSC/MKK
IF $DATA(XPDENV)
DO BMES^XPDUTL($$CJ^XLFSTR(TXT,$GET(IOM,80)))
End DoDot:1
+39 QUIT
+40 ;
CLEAN ;
+1 ; K ^TMP("LR343",$J)
+2 DO CLEAN^DILF
+3 QUIT
+4 ;
KILLDD(FIELD) ;
+1 ; Deletes the #69.9 field's DD
+2 NEW DIK,DA
+3 SET DIK="^DD(69.9,"
+4 SET DA=FIELD
+5 SET DA(1)=69.9
+6 DO ^DIK
+7 QUIT
+8 ;
+9 ; ---- BEGIN IHS/MSC/MKK - LR*5.2*1031
+10 ;
BIGHONK ; EP - Big, Honking Warning Message
+1 DO PASSMESG("ATTENTION")
+2 WRITE !
+3 WRITE ?4,"This install must now pause for 5 minutes in order to let all existing",!
+4 WRITE ?4,"events clear so that ""Can't Return To Source"" errors do not occur when",!
+5 WRITE ?4,"the LR70 MOVEMENT EVENT and LR70 MOVEMENT EVENT TASK protocols are",!
+6 WRITE ?4,"modified.",!!
+7 WRITE ?4,"An error would cause the other chained events not to be processed.",!!
+8 WRITE ?4,"Your patience is appreciated. Pause begins NOW at ",$$UP^XLFSTR($$HTE^XLFDT($HOROLOG,"5MPZ")),".",!
+9 QUIT
+10 ;
PASSMESG(WOT) ; EP -- Splash message
+1 NEW CRTLINE,MAXIT,AROUND
+2 ;
+3 FOR CRTLINE=1:1:21
WRITE $JUSTIFY("",80),!
+4 DO EN^XBVIDEO("HOM")
+5 SET MAXIT="@"
+6 FOR J=1:1:$LENGTH(WOT)
SET MAXIT=MAXIT_$EXTRACT(WOT,J,J)_"@"
+7 SET AROUND=$TRANSLATE($JUSTIFY("",8+$LENGTH(MAXIT))," ","@")
+8 SET MAXIT="@@!!"_$TRANSLATE(MAXIT," ","@")_"!!@@"
+9 ;
+10 WRITE !!
+11 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!
+12 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!
+13 WRITE $TRANSLATE($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
+14 WRITE $TRANSLATE($$CJ^XLFSTR(MAXIT,IOM)," @","* "),!
+15 WRITE $TRANSLATE($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
+16 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!
+17 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*"),!
+18 QUIT
+19 ;
+20 ; ---- END IHS/MSC/MKK - LR*5.2*1031
