LA88 ;DALOI/JMC - LA*5.2*88 KIDS ROUTINE ;3/4/16 17:15
;;5.2;AUTOMATED LAB INSTRUMENTS;**88**;Sep 27, 1994;Build 10
; Reference to file #771.5 supported by ICR DBIA1169-A
;
PRE ;
Q ;moved pre-install questions from build to environment check (en^la88a)
;
; KIDS Pre install for LA*5.2*88
;
;ZEXCEPT: XPDABORT,XPDQUES
;
D BMES("*** Pre install started ***")
;
; If not using Lab UI v1.6 then continue with install to upgrade interface to use HL7 2.5.1
; If using Lab UI v1.6 and site indicates they have upgraded their COTS to use HL v2.5.1 in HL7 messaging the continue with install.
; Abort install if site using Lab UI COTS and have not upgraded COTS system to send HL7 v2.5.1 in MSH segment.
I $G(XPDQUES("PRE1 LAB UI V1.6"))=1 D
. I $G(XPDQUES("PRE2 UPGRADED DRIVER"))=1 Q
. D BMES(" ")
. D BMES("Install aborted -- System not ready.")
. D BMES("Installer indicated that site using Lab UI v1.6")
. D MES(" and have not upgraded the LAB UI COTS to send HL7 v2.5.1 messages.")
. D MES("Refer to the Install Guide for more information.")
. D BMES(" ")
. S XPDABORT=1
;
D BMES("*** Pre install completed ***")
;
Q
;
;
POST ;
; KIDS Post install for LA*5.2*88
;
;ZEXCEPT: XPDNM
;
N STR,LAACTN,LAX,LAMSG,X,I,Y,LAUSR,LARECS,LACNT
N LAFDA,LAIEN,DIERR
D BMES("*** Post install started ***")
;
; Add Lab application proxy users to File #200
; CREATE^XUSAP/4677 (pending)
D BMES("Validating Lab application proxy users:")
F LAUSR="LRLAB,AUTO RELEASE","LRLAB,AUTO VERIFY" D
. S X=$$CREATE^XUSAP(LAUSR,"@",)
. D BMES("Lab application proxy user "_LAUSR_$S('X:" previously added.",X=-1:" **FAILED**",1:" added."))
;
; Update Lab UI related protocols in file #101
D FILE101(1)
;
D BMES("*** Post install completed ***")
D BMES("Sending install completion alert to mail group G.LMI")
S STR="Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)
D ALERT(STR)
;
Q
;
;
ALERT(MSG,RECIPS) ;
N DA,DIK,XQA,XQAMSG
S XQAMSG=$G(MSG)
I '$$GOTLOCAL^XMXAPIG("LMI") S XQA("G.LMI")=""
E S XQA(DUZ)=""
I $D(RECIPS) M XQA=RECIPS
D SETUP^XQALERT
Q
;
;
BMES(STR) ;
; Write string
D BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
Q
;
;
PROGRESS(LAST) ;
; Prints a "." when NOW > LAST + INT
; Input
; LAST : <byref> The last $H when "." was shown
N INT
S INT=1 ;interval in seconds
I $P($H,",",2)>(+$P(LAST,",",2)+INT) S LAST=$H W "."
Q
;
;
PTG ;
; Pre-Transport Global routine
Q
;
;
MES(STR,CJ,LM) ;
; Display a string using MES^XPDUTL
; Inputs
; STR: String to display
; CJ: Center text? 1=yes 0=1 <dflt=1>
; LM: Left Margin (padding)
N X
S STR=$G(STR)
S CJ=$G(CJ,1)
S LM=$G(LM)
I CJ S STR=$$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," ")
I 'CJ I LM S X="" S $P(X," ",LM)=" " S STR=X_STR
D MES^XPDUTL(STR)
Q
;
;
FILE101(LA7UPDATE) ; Update Lab UI protocols to HL7 v2.5.1
;
; Call with LA7UPDATE = 1 (update HL7 version on protocols)
; 2 (update HL7 version and ACK codes to use enhance mode)
;
N DIERR,I,LA101,LAFDA,LAHLACKCODE,LAHLVERSION,LAIEN,LAMSG,LANODE,LATXT,LAX
;
; Reference to file #771.5 supported by ICR DBIA1169-A
; Check LA7UI protocols and set to HL v2.5.1
;
D BMES("Starting checking and updating related Lab UI protocols in file #101")
;
S LAHLVERSION=$$FIND1^DIC(771.5,"","OX","2.5.1")
I LAHLVERSION<1 D Q
. D BMES("Unable to check/update Lab UI protocols")
. D BMES(" - could not identify HL7 v2.5.1 version entry in file #771.5")
. D BMES("Aborted checking and updating related Lab UI protocols in file #101")
;
I LA7UPDATE=2 D Q:LAHLACKCODE<1
. S LAHLACKCODE=$$FIND1^DIC(779.003,"","OX","AL")
. I LAHLACKCODE<1 D Q
. . D BMES("Unable to check/update Lab UI protocols")
. . D BMES(" - could not identify HL7 'AL' ACK condition in file #779.003")
. . D BMES("Aborted checking and updating related Lab UI protocols in file #101")
;
S LANODE="^ORD(101,""B"",""LA7UI"")"
F S LANODE=$Q(@LANODE) Q:LANODE="" Q:$QS(LANODE,2)'="B" Q:$QS(LANODE,3)'?1"LA7UI"1.E D
. S LAX=$QS(LANODE,3),LA101=$QS(LANODE,4)
. I LAX'["2.2" D BMES("Protocol "_LAX_" already updated to HL7 version 2.5.1")
. I 'LA101 Q
. K LAFDA,LAIEN,DIERR,LAMSG,LATXT
. S LAIEN=LA101_","
. I LAX["2.2" S LAFDA(1,101,LAIEN,.01)=$P(LAX," 2.2")
. I $$GET1^DIQ(101,LAIEN,770.95)="2.2" S LAFDA(1,101,LAIEN,770.95)=LAHLVERSION
. I LA7UPDATE=2,$$GET1^DIQ(101,LAIEN,4,"I")="E" D
. . S LAFDA(1,101,LAIEN,770.8)=LAHLACKCODE
. . S LAFDA(1,101,LAIEN,770.9)=LAHLACKCODE
. I '$D(LAFDA) Q
. D FILE^DIE("S","LAFDA(1)","LAMSG")
. I $G(LAMSG("DIERR")) D Q
. . D BMES("Protocol "_LAX_"could not be updated.")
. . D MSG^DIALOG("AEST",.LATXT,80,0,"LAMSG")
. . F I=1:1:LATXT D BMES("FileMan error: "_LATXT(I))
. I $D(LAFDA(1,101,LAIEN,.01)) D BMES("Protocol "_LAX_" name changed to "_$$GET1^DIQ(101,LAIEN,.01)_".")
. I $D(LAFDA(1,101,LAIEN,770.95)) D BMES("Protocol "_LAX_" updated to HL7 version 2.5.1.")
. I $D(LAFDA(1,101,LAIEN,770.8)) D BMES("Protocol "_LAX_" updated to HL7 Enhanced Mode Acknowledgments.")
. D CHECKWP(LAIEN)
;
D BMES("Finished checking and updating related Lab UI protocols in file #101")
Q
;
;
CHECKWP(LAIEN) ; Check description (WP) field on protocol and update text.
; Change reference to v2.2 to v2.5.1 in description.
; Call with LAIEN = IENS of entry in file #101
;
N FR,I,LAMSG,LATXT,LAX,WP,X
;
S LAX=$$GET1^DIQ(101,LAIEN,.01)
S X=$$GET1^DIQ(101,LAIEN,3.5,"","WP")
;
S I=0,FR("v2.2")="v2.5.1"
F S I=$O(WP(I)) Q:'I S WP(I)=$$REPLACE^XLFSTR(WP(I),.FR)
;
D WP^DIE(101,LAIEN,3.5,"","WP","LAMSG")
I $G(LAMSG("DIERR")) D
. D BMES("Protocol "_LAX_" description field (#3.5) could not be updated.")
. D MSG^DIALOG("AEST",.LATXT,80,0,"LAMSG")
. F I=1:1:LATXT D BMES("FileMan error: "_LATXT(I))
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA88 5973 printed Apr 09, 2024@20:46:59 Page 2
LA88 ;DALOI/JMC - LA*5.2*88 KIDS ROUTINE ;3/4/16 17:15
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**88**;Sep 27, 1994;Build 10
+2 ; Reference to file #771.5 supported by ICR DBIA1169-A
+3 ;
PRE ;
+1 ;moved pre-install questions from build to environment check (en^la88a)
QUIT
+2 ;
+3 ; KIDS Pre install for LA*5.2*88
+4 ;
+5 ;ZEXCEPT: XPDABORT,XPDQUES
+6 ;
+7 DO BMES("*** Pre install started ***")
+8 ;
+9 ; If not using Lab UI v1.6 then continue with install to upgrade interface to use HL7 2.5.1
+10 ; If using Lab UI v1.6 and site indicates they have upgraded their COTS to use HL v2.5.1 in HL7 messaging the continue with install.
+11 ; Abort install if site using Lab UI COTS and have not upgraded COTS system to send HL7 v2.5.1 in MSH segment.
+12 IF $GET(XPDQUES("PRE1 LAB UI V1.6"))=1
Begin DoDot:1
+13 IF $GET(XPDQUES("PRE2 UPGRADED DRIVER"))=1
QUIT
+14 DO BMES(" ")
+15 DO BMES("Install aborted -- System not ready.")
+16 DO BMES("Installer indicated that site using Lab UI v1.6")
+17 DO MES(" and have not upgraded the LAB UI COTS to send HL7 v2.5.1 messages.")
+18 DO MES("Refer to the Install Guide for more information.")
+19 DO BMES(" ")
+20 SET XPDABORT=1
End DoDot:1
+21 ;
+22 DO BMES("*** Pre install completed ***")
+23 ;
+24 QUIT
+25 ;
+26 ;
POST ;
+1 ; KIDS Post install for LA*5.2*88
+2 ;
+3 ;ZEXCEPT: XPDNM
+4 ;
+5 NEW STR,LAACTN,LAX,LAMSG,X,I,Y,LAUSR,LARECS,LACNT
+6 NEW LAFDA,LAIEN,DIERR
+7 DO BMES("*** Post install started ***")
+8 ;
+9 ; Add Lab application proxy users to File #200
+10 ; CREATE^XUSAP/4677 (pending)
+11 DO BMES("Validating Lab application proxy users:")
+12 FOR LAUSR="LRLAB,AUTO RELEASE","LRLAB,AUTO VERIFY"
Begin DoDot:1
+13 SET X=$$CREATE^XUSAP(LAUSR,"@",)
+14 DO BMES("Lab application proxy user "_LAUSR_$SELECT('X:" previously added.",X=-1:" **FAILED**",1:" added."))
End DoDot:1
+15 ;
+16 ; Update Lab UI related protocols in file #101
+17 DO FILE101(1)
+18 ;
+19 DO BMES("*** Post install completed ***")
+20 DO BMES("Sending install completion alert to mail group G.LMI")
+21 SET STR="Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)
+22 DO ALERT(STR)
+23 ;
+24 QUIT
+25 ;
+26 ;
ALERT(MSG,RECIPS) ;
+1 NEW DA,DIK,XQA,XQAMSG
+2 SET XQAMSG=$GET(MSG)
+3 IF '$$GOTLOCAL^XMXAPIG("LMI")
SET XQA("G.LMI")=""
+4 IF '$TEST
SET XQA(DUZ)=""
+5 IF $DATA(RECIPS)
MERGE XQA=RECIPS
+6 DO SETUP^XQALERT
+7 QUIT
+8 ;
+9 ;
BMES(STR) ;
+1 ; Write string
+2 DO BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$GET(IOM,80)),"R"," "))
+3 QUIT
+4 ;
+5 ;
PROGRESS(LAST) ;
+1 ; Prints a "." when NOW > LAST + INT
+2 ; Input
+3 ; LAST : <byref> The last $H when "." was shown
+4 NEW INT
+5 ;interval in seconds
SET INT=1
+6 IF $PIECE($HOROLOG,",",2)>(+$PIECE(LAST,",",2)+INT)
SET LAST=$HOROLOG
WRITE "."
+7 QUIT
+8 ;
+9 ;
PTG ;
+1 ; Pre-Transport Global routine
+2 QUIT
+3 ;
+4 ;
MES(STR,CJ,LM) ;
+1 ; Display a string using MES^XPDUTL
+2 ; Inputs
+3 ; STR: String to display
+4 ; CJ: Center text? 1=yes 0=1 <dflt=1>
+5 ; LM: Left Margin (padding)
+6 NEW X
+7 SET STR=$GET(STR)
+8 SET CJ=$GET(CJ,1)
+9 SET LM=$GET(LM)
+10 IF CJ
SET STR=$$TRIM^XLFSTR($$CJ^XLFSTR(STR,$GET(IOM,80)),"R"," ")
+11 IF 'CJ
IF LM
SET X=""
SET $PIECE(X," ",LM)=" "
SET STR=X_STR
+12 DO MES^XPDUTL(STR)
+13 QUIT
+14 ;
+15 ;
FILE101(LA7UPDATE) ; Update Lab UI protocols to HL7 v2.5.1
+1 ;
+2 ; Call with LA7UPDATE = 1 (update HL7 version on protocols)
+3 ; 2 (update HL7 version and ACK codes to use enhance mode)
+4 ;
+5 NEW DIERR,I,LA101,LAFDA,LAHLACKCODE,LAHLVERSION,LAIEN,LAMSG,LANODE,LATXT,LAX
+6 ;
+7 ; Reference to file #771.5 supported by ICR DBIA1169-A
+8 ; Check LA7UI protocols and set to HL v2.5.1
+9 ;
+10 DO BMES("Starting checking and updating related Lab UI protocols in file #101")
+11 ;
+12 SET LAHLVERSION=$$FIND1^DIC(771.5,"","OX","2.5.1")
+13 IF LAHLVERSION<1
Begin DoDot:1
+14 DO BMES("Unable to check/update Lab UI protocols")
+15 DO BMES(" - could not identify HL7 v2.5.1 version entry in file #771.5")
+16 DO BMES("Aborted checking and updating related Lab UI protocols in file #101")
End DoDot:1
QUIT
+17 ;
+18 IF LA7UPDATE=2
Begin DoDot:1
+19 SET LAHLACKCODE=$$FIND1^DIC(779.003,"","OX","AL")
+20 IF LAHLACKCODE<1
Begin DoDot:2
+21 DO BMES("Unable to check/update Lab UI protocols")
+22 DO BMES(" - could not identify HL7 'AL' ACK condition in file #779.003")
+23 DO BMES("Aborted checking and updating related Lab UI protocols in file #101")
End DoDot:2
QUIT
End DoDot:1
if LAHLACKCODE<1
QUIT
+24 ;
+25 SET LANODE="^ORD(101,""B"",""LA7UI"")"
+26 FOR
SET LANODE=$QUERY(@LANODE)
if LANODE=""
QUIT
if $QSUBSCRIPT(LANODE,2)'="B"
QUIT
if $QSUBSCRIPT(LANODE,3)'?1"LA7UI"1.E
QUIT
Begin DoDot:1
+27 SET LAX=$QSUBSCRIPT(LANODE,3)
SET LA101=$QSUBSCRIPT(LANODE,4)
+28 IF LAX'["2.2"
DO BMES("Protocol "_LAX_" already updated to HL7 version 2.5.1")
+29 IF 'LA101
QUIT
+30 KILL LAFDA,LAIEN,DIERR,LAMSG,LATXT
+31 SET LAIEN=LA101_","
+32 IF LAX["2.2"
SET LAFDA(1,101,LAIEN,.01)=$PIECE(LAX," 2.2")
+33 IF $$GET1^DIQ(101,LAIEN,770.95)="2.2"
SET LAFDA(1,101,LAIEN,770.95)=LAHLVERSION
+34 IF LA7UPDATE=2
IF $$GET1^DIQ(101,LAIEN,4,"I")="E"
Begin DoDot:2
+35 SET LAFDA(1,101,LAIEN,770.8)=LAHLACKCODE
+36 SET LAFDA(1,101,LAIEN,770.9)=LAHLACKCODE
End DoDot:2
+37 IF '$DATA(LAFDA)
QUIT
+38 DO FILE^DIE("S","LAFDA(1)","LAMSG")
+39 IF $GET(LAMSG("DIERR"))
Begin DoDot:2
+40 DO BMES("Protocol "_LAX_"could not be updated.")
+41 DO MSG^DIALOG("AEST",.LATXT,80,0,"LAMSG")
+42 FOR I=1:1:LATXT
DO BMES("FileMan error: "_LATXT(I))
End DoDot:2
QUIT
+43 IF $DATA(LAFDA(1,101,LAIEN,.01))
DO BMES("Protocol "_LAX_" name changed to "_$$GET1^DIQ(101,LAIEN,.01)_".")
+44 IF $DATA(LAFDA(1,101,LAIEN,770.95))
DO BMES("Protocol "_LAX_" updated to HL7 version 2.5.1.")
+45 IF $DATA(LAFDA(1,101,LAIEN,770.8))
DO BMES("Protocol "_LAX_" updated to HL7 Enhanced Mode Acknowledgments.")
+46 DO CHECKWP(LAIEN)
End DoDot:1
+47 ;
+48 DO BMES("Finished checking and updating related Lab UI protocols in file #101")
+49 QUIT
+50 ;
+51 ;
CHECKWP(LAIEN) ; Check description (WP) field on protocol and update text.
+1 ; Change reference to v2.2 to v2.5.1 in description.
+2 ; Call with LAIEN = IENS of entry in file #101
+3 ;
+4 NEW FR,I,LAMSG,LATXT,LAX,WP,X
+5 ;
+6 SET LAX=$$GET1^DIQ(101,LAIEN,.01)
+7 SET X=$$GET1^DIQ(101,LAIEN,3.5,"","WP")
+8 ;
+9 SET I=0
SET FR("v2.2")="v2.5.1"
+10 FOR
SET I=$ORDER(WP(I))
if 'I
QUIT
SET WP(I)=$$REPLACE^XLFSTR(WP(I),.FR)
+11 ;
+12 DO WP^DIE(101,LAIEN,3.5,"","WP","LAMSG")
+13 IF $GET(LAMSG("DIERR"))
Begin DoDot:1
+14 DO BMES("Protocol "_LAX_" description field (#3.5) could not be updated.")
+15 DO MSG^DIALOG("AEST",.LATXT,80,0,"LAMSG")
+16 FOR I=1:1:LATXT
DO BMES("FileMan error: "_LATXT(I))
End DoDot:1
+17 ;
+18 QUIT
