LA88.m

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 ---LA88   5973     printed  Mar 13, 2025@20:45:54                                                                                                                                                                                                        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