LR479 ;DALOI/FHS/TFF - LR*5.2*462 PATCH ENVIRONMENT CHECK ROUTINE; [2/21/17 9:13am]
;;5.2;LAB SERVICE;**479**;Sep 27, 1994;Build 8
ENV ; Does not prevent loading of the transport global.
; Environment check is done only during the install.
;
N XQA,XQAMSG
;
CHKNM ; Make sure the patch name exist
S XUMF=1
I '$D(XPDNM) D G EXIT
. D BMES("No valid patch name exist")
. S XPDQUIT=2
;
D CHECK
D EXIT
Q
;
CHECK ; Perform environment check
I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D
. D BMES("Terminal Device is not defined")
. S XPDQUIT=2
I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D
. D BMES("Please log in to set local DUZ... variables")
. S XPDQUIT=2
I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D
. D BMES("You are not a valid user on this system")
. S XPDQUIT=2
S XPDIQ("XPZ1","B")="NO" Q
EXIT ;
N XQA
I $G(XPDQUIT) D BMES("--- Install Environment Check FAILED ---") Q
D BMES("--- Environment Check is Ok ---")
S XQAMSG="Loading of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)
D BMES("Sending install loaded alert to mail group G.LMI")
S XQA("G.LMI")=""
D SETUP^XQALERT
H 5
Q
;
PRE ;Pre-install entry point
Q:'$D(XPDNM)
;
D BMES("*** Preinstall completed ***")
Q
POST ;Post install
;Clean up file 69.73
D SPELL,TITLE
;Set up CPRS AP ORDER MESSAGE LOG -
;CPRS AP ORDER MESSAGE IS STORE HERE FOR PROCESSING BY "TASKAP1^LR7OAPKM"
I '$G(^XTMP("LRAP1",0)) D
. S ^XTMP("LRAP1",0)=$$FMADD^XLFDT(DT+365)_U_DT_U_"CPRS AP ORDER MESSAGE LOG"
. S ^XTMP("LRAP1",1,0)=10
S $P(^XTMP("LRAP1",0),U,3)="CPRS AP ORDER MESSAGE LOG"
D
. D BMES("Sending install completion alert to mail group G.LMI")
. S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" Installed on "_$$HTE^XLFDT($H)
. S XQA("G.LMI")=""
. D SETUP^XQALERT
K LRDA,LRPRT,LRVR
CLEAN60 ; Remove obsolete fields from file 60
D BMES("Removing Obsolete fields from LABORATORY TEST (#60) File")
;Clean-up LABORATORY TEST field
N DIC,DIE,DA,DIK,X,Y
; Delete 60, AOE SCREEN field
S DA(1)=60.01,DA=21661,DIK="^DD(60.01," D ^DIK
;
CLEAN69 ; Remove obsolete field from file 69
; Clean-up LAB ORDER ENTRY file
;
D BMES("Remove Obsolete fields from LAB ORDER ENTRY (#69) File")
N DA,DAX,DIK
S DA=21661.1,DA(1)=69.02,DIK="^DD(69.02," D ^DIK ; Delete DIALOG subfile
K DA,DIK F DAX=21661.74 D
. S DA=DAX,DA(1)=69.01,DIK="^DD(69.01," D ^DIK ; Delete Surgery Case #
;
MESLMI ; Notify LIM patch is installed.
N XQA,XQAMSG
D BMES("Sending install completion alert to mail group G.LMI")
;
S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_"completed on "_$$HTE^XLFDT($H)
S XQA("G.LMI")=""
D SETUP^XQALERT
Q
BMES(STR) ;Write BMES^XPDUTL statements
W !
D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
Q
MAIL ;Send message to G.LMI local mail group of added 64 codes
N DIFROM,XMSUB,XMDUZ,XMTEXT,XMY,LRIEN,LRN
Q
;
SPELL ; Correct Spelling Errors
D BMES("Correcting Spelling Errors")
N SPEC,ND,WORD,SPELL,LN
S SPEC("Erosioin")="Erosion"
S SPEC("Technnique")="Technique"
S SPEC("SLide")="Slide"
S ND=$NA(^LAB(69.73)) F S ND=$Q(@ND) Q:ND="" Q:$QS(ND,1)'=69.73 D
. S WORD="" F S WORD=$O(SPEC(WORD)) Q:WORD="" D
. . I @ND[WORD S SPELL(ND)=ND_"="""_$$REPLACE^XLFSTR(@ND,.SPEC)_""""
. . I ND[WORD S SPELL(ND)=$$REPLACE^XLFSTR(ND,.SPEC)_"="""_@ND_""""
Q:'$D(SPELL)
S ND=$NA(SPELL) F S ND=$Q(@ND) Q:ND="" D
. K @$QS(ND,1) S LN=@ND S @LN
Q
;
TITLE ; Correct Builder Block Title Names
D BMES("Correcting Builder Block Title Names")
N ND,LN,I
S ND=$NA(^LAB(69.73)) F S ND=$Q(@ND) Q:ND="" Q:$QS(ND,1)'=69.73 D
. I @ND="Orchiectomy" D
. . S LN="^LAB(69.73," F I=2:1:5 S LN=LN_$QS(ND,I)_$S(I<5:",",1:")")
. . Q:$G(@LN@(1,0))'="Submission Type"
. . K @LN@("B")
. . S @LN@(1,0)="Specimen Type"
. . S @LN@("B","Specimen Type",1)=""
. . S @LN@(2,0)="Submission Type"
. . S @LN@("B","Submission Type",2)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR479 3971 printed Apr 09, 2024@21:13:24 Page 2
LR479 ;DALOI/FHS/TFF - LR*5.2*462 PATCH ENVIRONMENT CHECK ROUTINE; [2/21/17 9:13am]
+1 ;;5.2;LAB SERVICE;**479**;Sep 27, 1994;Build 8
ENV ; Does not prevent loading of the transport global.
+1 ; Environment check is done only during the install.
+2 ;
+3 NEW XQA,XQAMSG
+4 ;
CHKNM ; Make sure the patch name exist
+1 SET XUMF=1
+2 IF '$DATA(XPDNM)
Begin DoDot:1
+3 DO BMES("No valid patch name exist")
+4 SET XPDQUIT=2
End DoDot:1
GOTO EXIT
+5 ;
+6 DO CHECK
+7 DO EXIT
+8 QUIT
+9 ;
CHECK ; Perform environment check
+1 IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
Begin DoDot:1
+2 DO BMES("Terminal Device is not defined")
+3 SET XPDQUIT=2
End DoDot:1
+4 IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
Begin DoDot:1
+5 DO BMES("Please log in to set local DUZ... variables")
+6 SET XPDQUIT=2
End DoDot:1
+7 IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1
Begin DoDot:1
+8 DO BMES("You are not a valid user on this system")
+9 SET XPDQUIT=2
End DoDot:1
+10 SET XPDIQ("XPZ1","B")="NO"
QUIT
EXIT ;
+1 NEW XQA
+2 IF $GET(XPDQUIT)
DO BMES("--- Install Environment Check FAILED ---")
QUIT
+3 DO BMES("--- Environment Check is Ok ---")
+4 SET XQAMSG="Loading of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)
+5 DO BMES("Sending install loaded alert to mail group G.LMI")
+6 SET XQA("G.LMI")=""
+7 DO SETUP^XQALERT
+8 HANG 5
+9 QUIT
+10 ;
PRE ;Pre-install entry point
+1 if '$DATA(XPDNM)
QUIT
+2 ;
+3 DO BMES("*** Preinstall completed ***")
+4 QUIT
POST ;Post install
+1 ;Clean up file 69.73
+2 DO SPELL
DO TITLE
+3 ;Set up CPRS AP ORDER MESSAGE LOG -
+4 ;CPRS AP ORDER MESSAGE IS STORE HERE FOR PROCESSING BY "TASKAP1^LR7OAPKM"
+5 IF '$GET(^XTMP("LRAP1",0))
Begin DoDot:1
+6 SET ^XTMP("LRAP1",0)=$$FMADD^XLFDT(DT+365)_U_DT_U_"CPRS AP ORDER MESSAGE LOG"
+7 SET ^XTMP("LRAP1",1,0)=10
End DoDot:1
+8 SET $PIECE(^XTMP("LRAP1",0),U,3)="CPRS AP ORDER MESSAGE LOG"
+9 Begin DoDot:1
+10 DO BMES("Sending install completion alert to mail group G.LMI")
+11 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" Installed on "_$$HTE^XLFDT($HOROLOG)
+12 SET XQA("G.LMI")=""
+13 DO SETUP^XQALERT
End DoDot:1
+14 KILL LRDA,LRPRT,LRVR
CLEAN60 ; Remove obsolete fields from file 60
+1 DO BMES("Removing Obsolete fields from LABORATORY TEST (#60) File")
+2 ;Clean-up LABORATORY TEST field
+3 NEW DIC,DIE,DA,DIK,X,Y
+4 ; Delete 60, AOE SCREEN field
+5 SET DA(1)=60.01
SET DA=21661
SET DIK="^DD(60.01,"
DO ^DIK
+6 ;
CLEAN69 ; Remove obsolete field from file 69
+1 ; Clean-up LAB ORDER ENTRY file
+2 ;
+3 DO BMES("Remove Obsolete fields from LAB ORDER ENTRY (#69) File")
+4 NEW DA,DAX,DIK
+5 ; Delete DIALOG subfile
SET DA=21661.1
SET DA(1)=69.02
SET DIK="^DD(69.02,"
DO ^DIK
+6 KILL DA,DIK
FOR DAX=21661.74
Begin DoDot:1
+7 ; Delete Surgery Case #
SET DA=DAX
SET DA(1)=69.01
SET DIK="^DD(69.01,"
DO ^DIK
End DoDot:1
+8 ;
MESLMI ; Notify LIM patch is installed.
+1 NEW XQA,XQAMSG
+2 DO BMES("Sending install completion alert to mail group G.LMI")
+3 ;
+4 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_"completed on "_$$HTE^XLFDT($HOROLOG)
+5 SET XQA("G.LMI")=""
+6 DO SETUP^XQALERT
+7 QUIT
BMES(STR) ;Write BMES^XPDUTL statements
+1 WRITE !
+2 DO BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
+3 QUIT
MAIL ;Send message to G.LMI local mail group of added 64 codes
+1 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY,LRIEN,LRN
+2 QUIT
+3 ;
SPELL ; Correct Spelling Errors
+1 DO BMES("Correcting Spelling Errors")
+2 NEW SPEC,ND,WORD,SPELL,LN
+3 SET SPEC("Erosioin")="Erosion"
+4 SET SPEC("Technnique")="Technique"
+5 SET SPEC("SLide")="Slide"
+6 SET ND=$NAME(^LAB(69.73))
FOR
SET ND=$QUERY(@ND)
if ND=""
QUIT
if $QSUBSCRIPT(ND,1)'=69.73
QUIT
Begin DoDot:1
+7 SET WORD=""
FOR
SET WORD=$ORDER(SPEC(WORD))
if WORD=""
QUIT
Begin DoDot:2
+8 IF @ND[WORD
SET SPELL(ND)=ND_"="""_$$REPLACE^XLFSTR(@ND,.SPEC)_""""
+9 IF ND[WORD
SET SPELL(ND)=$$REPLACE^XLFSTR(ND,.SPEC)_"="""_@ND_""""
End DoDot:2
End DoDot:1
+10 if '$DATA(SPELL)
QUIT
+11 SET ND=$NAME(SPELL)
FOR
SET ND=$QUERY(@ND)
if ND=""
QUIT
Begin DoDot:1
+12 KILL @$QSUBSCRIPT(ND,1)
SET LN=@ND
SET @LN
End DoDot:1
+13 QUIT
+14 ;
TITLE ; Correct Builder Block Title Names
+1 DO BMES("Correcting Builder Block Title Names")
+2 NEW ND,LN,I
+3 SET ND=$NAME(^LAB(69.73))
FOR
SET ND=$QUERY(@ND)
if ND=""
QUIT
if $QSUBSCRIPT(ND,1)'=69.73
QUIT
Begin DoDot:1
+4 IF @ND="Orchiectomy"
Begin DoDot:2
+5 SET LN="^LAB(69.73,"
FOR I=2:1:5
SET LN=LN_$QSUBSCRIPT(ND,I)_$SELECT(I<5:",",1:")")
+6 if $GET(@LN@(1,0))'="Submission Type"
QUIT
+7 KILL @LN@("B")
+8 SET @LN@(1,0)="Specimen Type"
+9 SET @LN@("B","Specimen Type",1)=""
+10 SET @LN@(2,0)="Submission Type"
+11 SET @LN@("B","Submission Type",2)=""
End DoDot:2
End DoDot:1
+12 QUIT
