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
