LR281.m

LR281 ;VA/DALOI/CKA - LR*5.2*281 PATCH ENVIRONMENT CHECK ROUTINE ;4/22/2003

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

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

 ; Reference to ^ORD(101 supported by IA #872

EN ; Does not prevent loading of the transport global.

 ; Environment check is done only during the install.

 ;

 N XQA,XQAMSG

 ;

 I '$G(XPDENV) D  Q

 . S XQAMSG="Transport global for patch "_$G(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($H)

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

 . ; D SETUP^XQALERT

 . ; D BMES^XPDUTL($$CJ^XLFSTR("Sending transport global loaded alert to mail group G.LMI",80))

 ;

 S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($H)

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

 ; D SETUP^XQALERT

 ;

 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

 . D BMES^XPDUTL($$CJ^XLFSTR("Please log in to set local DUZ... variables",80))

 . S XPDQUIT=2

 I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D  Q

 . D BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80))

 . S XPDQUIT=2

 Q

 ;

EXIT ;

 I $G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("--- Install Environment Check FAILED ---",80))

 I '$G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is Ok ---",80))

 I '$G(XPDQUIT) D

 .S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)

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

 .; D SETUP^XQALERT

 .D BMES^XPDUTL($$CJ^XLFSTR("Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H),80))

 Q

 ;

 ;

PRE ; KIDS Pre install for LR*5.2*281

 ;Pre-install entry point

 ;Delete NCH entries

 Q:'($O(^LAB(69.5,"B","NCH CHOLESTEROL",0)))

 Q:'($O(^LAB(69.5,"B","NCH PAP SMEAR",0)))

 D BMES^XPDUTL($$CJ^XLFSTR("Deleting NCH entries from LAB/SEARCH EXTRACT file (#69.5)",80))

 S LRNUM(1)=$O(^LAB(69.5,"B","NCH CHOLESTEROL",0))

 S LRNUM(2)=$O(^LAB(69.5,"B","NCH PAP SMEAR",0))

 S DIK="^LAB(69.5," F LRNUM=1:1:2 S DA=LRNUM(LRNUM) D ^DIK

 K DIK,DA,LRNUM

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

 Q

 ;

 ;

POST ; KIDS Post install for LR*5.2*281

 ; Set Lag Days =15 for all pathogens

 S LRNUM=0

 F  S LRNUM=$O(^LAB(69.5,LRNUM)) Q:LRNUM'>0  S $P(^LAB(69.5,LRNUM,0),U,3)=15

 ;

 ; Set Previous Cycle field for TB=1

 Q:'$D(^LAB(69.5,5,0))

 Q:$P(^LAB(69.5,5,0),U)'="TUBERCULOSIS"

 S $P(^LAB(69.5,5,0),U,13)=1

 ;Make sure the protocol is correct

 S LREPI=0,LRNUM=0,LREPI=$O(^ORD(101,"B","LREPI",LREPI))

 F  S LRNUM=$O(^LAB(69.5,LRNUM)) Q:LRNUM=""  S $P(^LAB(69.5,LRNUM,0),U,7)=LREPI

 ;delete the NCH protocol from 69.4-all but LREPI deleted

 S LRNUM=0

 F  S LRNUM=$O(^LAB(69.4,LRNUM)) Q:LRNUM=""  I LREPI'=LRNUM D

 .S DIK="^LAB(69.4,",DA=LRNUM

 .D ^DIK

 .K DIK,DA

 K LREPI,LRNUM

 Q

LR281     ;VA/DALOI/CKA - LR*5.2*281 PATCH ENVIRONMENT CHECK ROUTINE ;4/22/2003

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

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

 +3       ; Reference to ^ORD(101 supported by IA #872

EN        ; Does not prevent loading of the transport global.

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

 +2       ;

 +3        NEW XQA,XQAMSG

 +4       ;

 +5        IF '$GET(XPDENV)

               Begin DoDot:1

 +6                SET XQAMSG="Transport global for patch "_$GET(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($HOROLOG)

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

 +8       ; D SETUP^XQALERT

 +9       ; D BMES^XPDUTL($$CJ^XLFSTR("Sending transport global loaded alert to mail group G.LMI",80))

               End DoDot:1

               QUIT 

 +10      ;

 +11       SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($HOROLOG)

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

 +13      ; D SETUP^XQALERT

 +14      ;

 +15       DO CHECK

 +16       DO EXIT

 +17       QUIT 

 +18      ;

CHECK     ; Perform environment check

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

               Begin DoDot:1

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

 +3                SET XPDQUIT=2

               End DoDot:1

               QUIT 

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

               Begin DoDot:1

 +5                DO BMES^XPDUTL($$CJ^XLFSTR("Please log in to set local DUZ... variables",80))

 +6                SET XPDQUIT=2

               End DoDot:1

               QUIT 

 +7        IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1

               Begin DoDot:1

 +8                DO BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80))

 +9                SET XPDQUIT=2

               End DoDot:1

               QUIT 

 +10       QUIT 

 +11      ;

EXIT      ;

 +1        IF $GET(XPDQUIT)

               DO BMES^XPDUTL($$CJ^XLFSTR("--- Install Environment Check FAILED ---",80))

 +2        IF '$GET(XPDQUIT)

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

 +3        IF '$GET(XPDQUIT)

               Begin DoDot:1

 +4                SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)

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

 +6       ; D SETUP^XQALERT

 +7                DO BMES^XPDUTL($$CJ^XLFSTR("Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG),80))

               End DoDot:1

 +8        QUIT 

 +9       ;

 +10      ;

PRE       ; KIDS Pre install for LR*5.2*281

 +1       ;Pre-install entry point

 +2       ;Delete NCH entries

 +3        IF '($ORDER(^LAB(69.5,"B","NCH CHOLESTEROL",0)))

               QUIT 

 +4        IF '($ORDER(^LAB(69.5,"B","NCH PAP SMEAR",0)))

               QUIT 

 +5        DO BMES^XPDUTL($$CJ^XLFSTR("Deleting NCH entries from LAB/SEARCH EXTRACT file (#69.5)",80))

 +6        SET LRNUM(1)=$ORDER(^LAB(69.5,"B","NCH CHOLESTEROL",0))

 +7        SET LRNUM(2)=$ORDER(^LAB(69.5,"B","NCH PAP SMEAR",0))

 +8        SET DIK="^LAB(69.5,"

           FOR LRNUM=1:1:2

               SET DA=LRNUM(LRNUM)

               DO ^DIK

 +9        KILL DIK,DA,LRNUM

 +10       DO BMES^XPDUTL($$CJ^XLFSTR("*** Preinstall completed ***",80))

 +11       QUIT 

 +12      ;

 +13      ;

POST      ; KIDS Post install for LR*5.2*281

 +1       ; Set Lag Days =15 for all pathogens

 +2        SET LRNUM=0

 +3        FOR 

               SET LRNUM=$ORDER(^LAB(69.5,LRNUM))

               IF LRNUM'>0

                   QUIT 

               SET $PIECE(^LAB(69.5,LRNUM,0),U,3)=15

 +4       ;

 +5       ; Set Previous Cycle field for TB=1

 +6        IF '$DATA(^LAB(69.5,5,0))

               QUIT 

 +7        IF $PIECE(^LAB(69.5,5,0),U)'="TUBERCULOSIS"

               QUIT 

 +8        SET $PIECE(^LAB(69.5,5,0),U,13)=1

 +9       ;Make sure the protocol is correct

 +10       SET LREPI=0

           SET LRNUM=0

           SET LREPI=$ORDER(^ORD(101,"B","LREPI",LREPI))

 +11       FOR 

               SET LRNUM=$ORDER(^LAB(69.5,LRNUM))

               IF LRNUM=""

                   QUIT 

               SET $PIECE(^LAB(69.5,LRNUM,0),U,7)=LREPI

 +12      ;delete the NCH protocol from 69.4-all but LREPI deleted

 +13       SET LRNUM=0

 +14       FOR 

               SET LRNUM=$ORDER(^LAB(69.4,LRNUM))

               IF LRNUM=""

                   QUIT 

               IF LREPI'=LRNUM

                   Begin DoDot:1

 +15                   SET DIK="^LAB(69.4,"

                       SET DA=LRNUM

 +16                   DO ^DIK

 +17                   KILL DIK,DA

                   End DoDot:1

 +18       KILL LREPI,LRNUM

 +19       QUIT