LR317.m

LR317 ;VA/DALOI/KLL - LR*5.2*317 PATCH ENVIRONMENT CHECK ROUTINE ;09/21/02

 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

 ;;5.2;LAB SERVICE;**317**;Sep 27, 1994

EN ; Does not prevent loading of the transport global.

 ; Environment check is done only during the install.

 ;

 I '$G(XPDENV) D  Q

 .N XQA,XQAMSG

 .S XQAMSG="Transport global for patch "_$G(XPDNM,"Unknown patch")

 .S XQAMSG=XQAMSG_" loaded on "_$$HTE^XLFDT($H)

 .S XQA("G.LMI")=""

 .; D SETUP^XQALERT

 .; S MSG="Sending transport global loaded alert to mail group G.LMI"

 .; D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 ;

 D CHECK

 D EXIT

 Q

 ;

CHECK ; Perform environment check

 ;

 I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D  Q

 .D BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",80))

 .S XPDQUIT=2

 ;

 I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D  Q

 .S MSG="Please log in to set local DUZ... variables"

 .D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 .S XPDQUIT=2

 ;

 I '$D(^VA(200,$G(DUZ),0))#2 D  Q

 .S MSG="You are not a valid user on this system"

 .D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 .S XPDQUIT=2

 ;

 S XPDIQ("XPZ1","B")="NO"

 ;

 Q:'$$PROD^XUPROD  ;LINE ADDED FOR TEST SITES

 ;CHECK FOR UNRELEASED SUPPLEMENTARY REPORTS FROM JUNE 7,2004

 S MSG="Unreleased supplemental report(s) from July 23,2003 until present- must be released before install."

 D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 S LRSS="AU",LRSDT=3030723-.01 D  S LRSS="CY",LRSDT=3030723-.01 D  S LRSS="EM",LRSDT=3030723-.01 D  S LRSS="SP",LRSDT=3030723-.01 D

 .S LRXR="A"_LRSS

 .F  S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT  S LRDFN=0 F  S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN  D

 ..S LRI=0 F  S LRI=$O(^LR(LRXR,LRSDT,LRDFN,LRI)) Q:'LRI  D

 ...S LRNUM=0 F  S LRNUM=$O(^LR(LRDFN,LRSS,LRI,1.2,LRNUM)) Q:'LRNUM  D

 ....I LRSS'="AU" S LRX=$G(^LR(LRDFN,LRSS,LRI,1.2,LRNUM,0))

 ....I LRSS="AU" S LRX=$G(^LR(LRDFN,84,LRNUM,0))

 ....S LRRLS2=+$P(LRX,"^",2)

 ....I 'LRRLS2 D

 .....I $G(^LR(LRDFN,0)) S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)

 .....I LRDPF=2 S PNM=$P(^DPT(DFN,0),U)

 .....I LRDPF'=2 D

 ......S X=$$GET1^DID(1,LRDPF,"","GLOBAL NAME","ANS","ANS1")

 ......S X=X_DFN_",0)",X=$S($D(@X):@X,1:"") S PNM=$P(X,U)

 .....S MSG="Name: "_PNM_"  Accession: "_$P(^LR(LRDFN,LRSS,LRI,0),U,6)

 .....D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 .....S XPDQUIT=2

 ;

 Q

 ;

EXIT ;

 I $G(XPDQUIT) D

 .S MSG="--- Install Environment Check FAILED ---"

 .D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 I '$G(XPDQUIT) D

 .D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is Ok ---",80))

 Q

 ;

PRE ; KIDS Pre install for LR*5.2*317

 ;

 N XQA,XQAMSG

 S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")

 S XQAMSG=XQAMSG_" started on "_$$HTE^XLFDT($H)

 ; S XQA("G.LMI")=""

 ; D SETUP^XQALERT

 ;

 S MSG="Sending install started alert to mail group G.LMI"

 ; D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 ;

 D BMES^XPDUTL($$CJ^XLFSTR("*** Pre install started ***",80))

 ;

 S Y=$$OPTDE^XPDUTL("LRAP",2)

 S MSG="Disabling Anatomic Pathology [LRAP] option"

 D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 ;

 D BMES^XPDUTL($$CJ^XLFSTR("*** Pre install completed ***",80))

 ;

 Q

 ;

POST ; KIDS Post install for LR*5.2*317

 ;

 N XQA,XQAMSG

 D BMES^XPDUTL($$CJ^XLFSTR("*** Post install started ***",80))

 ;

 S Y=$$OPTDE^XPDUTL("LRAP",1)

 S MSG="Enabling Anatomic Pathology [LRAP] option"

 D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 ;

 D BMES^XPDUTL($$CJ^XLFSTR("*** Post install completed ***",80))

 ;

 S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")

 S XQAMSG=XQAMSG_" completed on "_$$HTE^XLFDT($H)

 S XQA("G.LMI")=""

 ; D SETUP^XQALERT

 ;

 ; S MSG="Sending install completion alert to mail group G.LMI"

 ; D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 ;

 Q

LR317     ;VA/DALOI/KLL - LR*5.2*317 PATCH ENVIRONMENT CHECK ROUTINE ;09/21/02

 +1       ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

 +2       ;;5.2;LAB SERVICE;**317**;Sep 27, 1994

EN        ; Does not prevent loading of the transport global.

 +1       ; Environment check is done only during the install.

 +2       ;

 +3        IF '$GET(XPDENV)

               Begin DoDot:1

 +4                NEW XQA,XQAMSG

 +5                SET XQAMSG="Transport global for patch "_$GET(XPDNM,"Unknown patch")

 +6                SET XQAMSG=XQAMSG_" loaded on "_$$HTE^XLFDT($HOROLOG)

 +7                SET XQA("G.LMI")=""

 +8       ; D SETUP^XQALERT

 +9       ; S MSG="Sending transport global loaded alert to mail group G.LMI"

 +10      ; D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

               End DoDot:1

               QUIT 

 +11      ;

 +12       DO CHECK

 +13       DO EXIT

 +14       QUIT 

 +15      ;

CHECK     ; Perform environment check

 +1       ;

 +2        IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)

               Begin DoDot:1

 +3                DO BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",80))

 +4                SET XPDQUIT=2

               End DoDot:1

               QUIT 

 +5       ;

 +6        IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)

               Begin DoDot:1

 +7                SET MSG="Please log in to set local DUZ... variables"

 +8                DO BMES^XPDUTL($$CJ^XLFSTR(MSG,80))

                   KILL MSG

 +9                SET XPDQUIT=2

               End DoDot:1

               QUIT 

 +10      ;

 +11       IF '$DATA(^VA(200,$GET(DUZ),0))#2

               Begin DoDot:1

 +12               SET MSG="You are not a valid user on this system"

 +13               DO BMES^XPDUTL($$CJ^XLFSTR(MSG,80))

                   KILL MSG

 +14               SET XPDQUIT=2

               End DoDot:1

               QUIT 

 +15      ;

 +16       SET XPDIQ("XPZ1","B")="NO"

 +17      ;

 +18      ;LINE ADDED FOR TEST SITES

           IF '$$PROD^XUPROD

               QUIT 

 +19      ;CHECK FOR UNRELEASED SUPPLEMENTARY REPORTS FROM JUNE 7,2004

 +20       SET MSG="Unreleased supplemental report(s) from July 23,2003 until present- must be released before install."

 +21       DO BMES^XPDUTL($$CJ^XLFSTR(MSG,80))

           KILL MSG

 +22       SET LRSS="AU"

           SET LRSDT=3030723-.01

           Begin DoDot:1

 +23           SET LRXR="A"_LRSS

 +24           FOR 

                   SET LRSDT=$ORDER(^LR(LRXR,LRSDT))

                   IF 'LRSDT

                       QUIT 

                   SET LRDFN=0

                   FOR 

                       SET LRDFN=$ORDER(^LR(LRXR,LRSDT,LRDFN))

                       IF 'LRDFN

                           QUIT 

                       Begin DoDot:2

 +25                       SET LRI=0

                           FOR 

                               SET LRI=$ORDER(^LR(LRXR,LRSDT,LRDFN,LRI))

                               IF 'LRI

                                   QUIT 

                               Begin DoDot:3

 +26                               SET LRNUM=0

                                   FOR 

                                       SET LRNUM=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,LRNUM))

                                       IF 'LRNUM

                                           QUIT 

                                       Begin DoDot:4

 +27                                       IF LRSS'="AU"

                                               SET LRX=$GET(^LR(LRDFN,LRSS,LRI,1.2,LRNUM,0))

 +28                                       IF LRSS="AU"

                                               SET LRX=$GET(^LR(LRDFN,84,LRNUM,0))

 +29                                       SET LRRLS2=+$PIECE(LRX,"^",2)

 +30                                       IF 'LRRLS2

                                               Begin DoDot:5

 +31                                               IF $GET(^LR(LRDFN,0))

                                                       SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)

                                                       SET DFN=$PIECE(^(0),U,3)

 +32                                               IF LRDPF=2

                                                       SET PNM=$PIECE(^DPT(DFN,0),U)

 +33                                               IF LRDPF'=2

                                                       Begin DoDot:6

 +34                                                       SET X=$$GET1^DID(1,LRDPF,"","GLOBAL NAME","ANS","ANS1")

 +35                                                       SET X=X_DFN_",0)"

                                                           SET X=$SELECT($DATA(@X):@X,1:"")

                                                           SET PNM=$PIECE(X,U)

                                                       End DoDot:6

 +36                                               SET MSG="Name: "_PNM_"  Accession: "_$PIECE(^LR(LRDFN,LRSS,LRI,0),U,6)

 +37                                               DO BMES^XPDUTL($$CJ^XLFSTR(MSG,80))

                                                   KILL MSG

 +38                                               SET XPDQUIT=2

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

           End DoDot:1

           SET LRSS="CY"

           SET LRSDT=3030723-.01

           Begin DoDot:1

           End DoDot:1

           SET LRSS="EM"

           SET LRSDT=3030723-.01

           Begin DoDot:1

           End DoDot:1

           SET LRSS="SP"

           SET LRSDT=3030723-.01

           Begin DoDot:1

           End DoDot:1

 +39      ;

 +40       QUIT 

 +41      ;

EXIT      ;

 +1        IF $GET(XPDQUIT)

               Begin DoDot:1

 +2                SET MSG="--- Install Environment Check FAILED ---"

 +3                DO BMES^XPDUTL($$CJ^XLFSTR(MSG,80))

                   KILL MSG

               End DoDot:1

 +4        IF '$GET(XPDQUIT)

               Begin DoDot:1

 +5                DO BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is Ok ---",80))

               End DoDot:1

 +6        QUIT 

 +7       ;

PRE       ; KIDS Pre install for LR*5.2*317

 +1       ;

 +2        NEW XQA,XQAMSG

 +3        SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")

 +4        SET XQAMSG=XQAMSG_" started on "_$$HTE^XLFDT($HOROLOG)

 +5       ; S XQA("G.LMI")=""

 +6       ; D SETUP^XQALERT

 +7       ;

 +8        SET MSG="Sending install started alert to mail group G.LMI"

 +9       ; D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 +10      ;

 +11       DO BMES^XPDUTL($$CJ^XLFSTR("*** Pre install started ***",80))

 +12      ;

 +13       SET Y=$$OPTDE^XPDUTL("LRAP",2)

 +14       SET MSG="Disabling Anatomic Pathology [LRAP] option"

 +15       DO BMES^XPDUTL($$CJ^XLFSTR(MSG,80))

           KILL MSG

 +16      ;

 +17       DO BMES^XPDUTL($$CJ^XLFSTR("*** Pre install completed ***",80))

 +18      ;

 +19       QUIT 

 +20      ;

POST      ; KIDS Post install for LR*5.2*317

 +1       ;

 +2        NEW XQA,XQAMSG

 +3        DO BMES^XPDUTL($$CJ^XLFSTR("*** Post install started ***",80))

 +4       ;

 +5        SET Y=$$OPTDE^XPDUTL("LRAP",1)

 +6        SET MSG="Enabling Anatomic Pathology [LRAP] option"

 +7        DO BMES^XPDUTL($$CJ^XLFSTR(MSG,80))

           KILL MSG

 +8       ;

 +9        DO BMES^XPDUTL($$CJ^XLFSTR("*** Post install completed ***",80))

 +10      ;

 +11       SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")

 +12       SET XQAMSG=XQAMSG_" completed on "_$$HTE^XLFDT($HOROLOG)

 +13       SET XQA("G.LMI")=""

 +14      ; D SETUP^XQALERT

 +15      ;

 +16      ; S MSG="Sending install completion alert to mail group G.LMI"

 +17      ; D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG

 +18      ;

 +19       QUIT