LR350A ;DALOI/JMC - LR*5.2*350 KIDS ROUTINE CONT ;12/05/11 12:11
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
Q
;
;
PRE ;
; KIDS Pre install for LR*5.2*350
N X,DA,DIU,DIK,LRERR,LRFN,LRFLD,LRMSG
D BMES("*** Pre install started ***")
; Delete SNOMED fields - (field is now not required)
D BMES("Purging field #2 DD for file #61 and file #61.2")
K DA,DIK
S DA=2,DA(1)=61,DIK="^DD(61," D ^DIK K DA,DIK
S DA=2,DA(1)=61.2,DIK="^DD(61.2," D ^DIK K DA,DIK
;
; Delete SNOMED CT fields #20-24 in files 61, 61.2, 62
; if installed due to previous test build to insure clean install of these fields.
F LRFN=61,61.2,62 D
. F LRFLD=20:1:24 D
. . I '$$VFIELD^DILFD(LRFN,LRFLD) Q
. . N DA,DIK
. . D BMES("Purging field #"_LRFLD_" DD for file #"_LRFN)
. . S DA=LRFLD,DA(1)=LRFN,DIK="^DD("_LRFN_"," D ^DIK
;
; Purge NLT files
D BMES("Purging DDs and data for files #64.061, #64.062, #95.4")
K DA,DIU
S DIU="^LAB(64.061,",DIU(0)="DS" D EN^DIU2 K DIU,DA
S DIU="^LAB(64.062,",DIU(0)="DS" D EN^DIU2 K DIU,DA
S DIU="^LAHM(95.4,",DIU(0)="DS" D EN^DIU2 K DIU,DA
;
; Purge Micro Audit subfile DD (leave data)
D BMES("Deleting DD for Micro Audit subfile #63.539")
K DA,DIU
S DIU=63.539,DIU(0)="S" D EN^DIU2 K DIU,DA
;
; Delete "AB" xref on COLLECTION SAMPLE field (60.03,.01)
K LRERR,LRMSG
D BMES("Deleting ""AB"" cross reference on COLLECTION SAMPLE field (#60.03,.01)")
D DELIX^DDMOD(60.03,.01,2,"K","LRMSG","LRERR")
I $G(LRERR("DIERR",1))=202 D BMES("""AB"" cross reference previously removed")
;
;
; Delete "AE" xref on CANCELED BY field (69.03,10)
K LRERR,LRMSG
D BMES("Deleting ""AE"" cross reference on CANCELED BY field (#69.03,10)")
D DELIX^DDMOD(69.03,10,1,"","LRMSG","LRERR")
I $G(LRERR("DIERR",1))=202 D BMES("""AE"" cross reference previously removed")
;
D BMES("*** Pre install completed ***")
Q
;
;
POST ; KIDS Post install for LR*5.2*350
N LRX,LRI,LRMSG,STR,X
;
;ZEXCEPT: XPDNM
;
D BMES("*** Post install started ***")
D BMES("*** Configuring mail group 'LAB MAPPING' ***")
D LABMAP
S STR="Patch LR*5.2*350 - add local members to mail group 'LAB MAPPING'"
D ALERT(STR)
;
D BMES("Re-Indexing ""B"" cross-reference of file #61")
D RINDXB61
D BMES("Re-Indexing completed")
;
;D MICHECK1
D MICHECK2
D LRWU9
;
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) ;
D ALERT^LR350(MSG,.RECIPS)
Q
;
;
BMES(STR) ;
D BMES^LR350(STR)
Q
;
;
MES(STR,CJ,LM) ;
D MES^LR350(STR,$G(CJ),$G(LM))
Q
;
;
LABMAP ;
;
N DIERR,LRIEN,LRFDA,LRMSG
S LRIEN=$O(^XMB(3.8,"B","LAB MAPPING",0))
I LRIEN<1 Q
; Set access levels
S LRIEN=LRIEN_","
S LRFDA(1,3.8,LRIEN,4)="PU" ; type
S LRFDA(1,3.8,LRIEN,7)="n" ; self enroll
D FILE^DIE("","LRFDA(1)","LRMSG")
Q
;
;
MICHECK1 ; Task routine LR350M to check for bad nodes in MI subscript.
;
;
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
D BMES("*** Tasking post-install check of MI subscript in LAB DATA file ***")
S ZTRTN="EN^LR350M",ZTDTH=$H,ZTIO=""
S ZTDESC="Check file #63 MI subscript (post-LR*5.2*350)"
D ^%ZTLOAD
I $G(ZTSK)>0 D BMES("*** Task #"_ZTSK_" created ***")
I $G(ZTSK)<1 D
. D BMES("*** Tasking FAILED ***")
. D BMES("*** with error "_$G(%ZTLOAD("ERROR"))_" ***")
;
Q
;
;
MICHECK2 ; Task routine LRUW8 to check for bad antibiotic field definition in MI subscript.
;
;
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
D BMES("*** Tasking post-install check of MI Antibiotic Field Definitions in LAB DATA file ***")
S ZTRTN="KIDS^LRWU8",ZTDTH=$H,ZTIO=""
S ZTDESC="Check file #63 MI Antibiotic Field Definitions (post-LR*5.2*350)"
D ^%ZTLOAD
I $G(ZTSK)>0 D BMES("*** Task #"_ZTSK_" created ***")
I $G(ZTSK)<1 D
. D BMES("*** Tasking FAILED ***")
. D BMES("*** with error "_$G(%ZTLOAD("ERROR"))_" ***")
;
Q
LRWU9 ;Task LRWU9 to check for bad Chemistry test names
;
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
;
S ZTDESC="*** Tasking post-install check of bad test names"
D BMES^XPDUTL($$CJ^XLFSTR(ZTDESC,80))
;
S ZTRTN="KIDS^LRWU9",ZTDTH=$H,ZTIO=""
S ZTDESC="Check file #63 for bad test Chemistry names."
D ^%ZTLOAD
;
I $G(ZTSK)<1 D
. S ZTDESC="*** Tasking FAILED ***"
. D BMES^XPDUTL($$CJ^XLFSTR(ZTDESC,80))
. S ZTDESC="*** with error "_$G(%ZTLOAD("ERROR"))_" ***"
. D BMES^XPDUTL($$CJ^XLFSTR(ZTDESC,80))
;
Q
;
;
RINDXB61 ; Re-index "B" cross-reference of File #61 (as it changed from 30 to 80 chars)
;
N DA,DIK,LRFMERTS
;
S LRFMERTS=1
K ^LAB(61,"B")
S DIK="^LAB(61,"
S DIK(1)=".01^B"
D ENALL^DIK
K DIK
S DIK="^LAB(61,"
S DIK(1)="6^B"
D ENALL^DIK
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR350A 4870 printed Apr 09, 2024@21:12:18 Page 2
LR350A ;DALOI/JMC - LR*5.2*350 KIDS ROUTINE CONT ;12/05/11 12:11
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 QUIT
+4 ;
+5 ;
PRE ;
+1 ; KIDS Pre install for LR*5.2*350
+2 NEW X,DA,DIU,DIK,LRERR,LRFN,LRFLD,LRMSG
+3 DO BMES("*** Pre install started ***")
+4 ; Delete SNOMED fields - (field is now not required)
+5 DO BMES("Purging field #2 DD for file #61 and file #61.2")
+6 KILL DA,DIK
+7 SET DA=2
SET DA(1)=61
SET DIK="^DD(61,"
DO ^DIK
KILL DA,DIK
+8 SET DA=2
SET DA(1)=61.2
SET DIK="^DD(61.2,"
DO ^DIK
KILL DA,DIK
+9 ;
+10 ; Delete SNOMED CT fields #20-24 in files 61, 61.2, 62
+11 ; if installed due to previous test build to insure clean install of these fields.
+12 FOR LRFN=61,61.2,62
Begin DoDot:1
+13 FOR LRFLD=20:1:24
Begin DoDot:2
+14 IF '$$VFIELD^DILFD(LRFN,LRFLD)
QUIT
+15 NEW DA,DIK
+16 DO BMES("Purging field #"_LRFLD_" DD for file #"_LRFN)
+17 SET DA=LRFLD
SET DA(1)=LRFN
SET DIK="^DD("_LRFN_","
DO ^DIK
End DoDot:2
End DoDot:1
+18 ;
+19 ; Purge NLT files
+20 DO BMES("Purging DDs and data for files #64.061, #64.062, #95.4")
+21 KILL DA,DIU
+22 SET DIU="^LAB(64.061,"
SET DIU(0)="DS"
DO EN^DIU2
KILL DIU,DA
+23 SET DIU="^LAB(64.062,"
SET DIU(0)="DS"
DO EN^DIU2
KILL DIU,DA
+24 SET DIU="^LAHM(95.4,"
SET DIU(0)="DS"
DO EN^DIU2
KILL DIU,DA
+25 ;
+26 ; Purge Micro Audit subfile DD (leave data)
+27 DO BMES("Deleting DD for Micro Audit subfile #63.539")
+28 KILL DA,DIU
+29 SET DIU=63.539
SET DIU(0)="S"
DO EN^DIU2
KILL DIU,DA
+30 ;
+31 ; Delete "AB" xref on COLLECTION SAMPLE field (60.03,.01)
+32 KILL LRERR,LRMSG
+33 DO BMES("Deleting ""AB"" cross reference on COLLECTION SAMPLE field (#60.03,.01)")
+34 DO DELIX^DDMOD(60.03,.01,2,"K","LRMSG","LRERR")
+35 IF $GET(LRERR("DIERR",1))=202
DO BMES("""AB"" cross reference previously removed")
+36 ;
+37 ;
+38 ; Delete "AE" xref on CANCELED BY field (69.03,10)
+39 KILL LRERR,LRMSG
+40 DO BMES("Deleting ""AE"" cross reference on CANCELED BY field (#69.03,10)")
+41 DO DELIX^DDMOD(69.03,10,1,"","LRMSG","LRERR")
+42 IF $GET(LRERR("DIERR",1))=202
DO BMES("""AE"" cross reference previously removed")
+43 ;
+44 DO BMES("*** Pre install completed ***")
+45 QUIT
+46 ;
+47 ;
POST ; KIDS Post install for LR*5.2*350
+1 NEW LRX,LRI,LRMSG,STR,X
+2 ;
+3 ;ZEXCEPT: XPDNM
+4 ;
+5 DO BMES("*** Post install started ***")
+6 DO BMES("*** Configuring mail group 'LAB MAPPING' ***")
+7 DO LABMAP
+8 SET STR="Patch LR*5.2*350 - add local members to mail group 'LAB MAPPING'"
+9 DO ALERT(STR)
+10 ;
+11 DO BMES("Re-Indexing ""B"" cross-reference of file #61")
+12 DO RINDXB61
+13 DO BMES("Re-Indexing completed")
+14 ;
+15 ;D MICHECK1
+16 DO MICHECK2
+17 DO LRWU9
+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 QUIT
+24 ;
+25 ;
ALERT(MSG,RECIPS) ;
+1 DO ALERT^LR350(MSG,.RECIPS)
+2 QUIT
+3 ;
+4 ;
BMES(STR) ;
+1 DO BMES^LR350(STR)
+2 QUIT
+3 ;
+4 ;
MES(STR,CJ,LM) ;
+1 DO MES^LR350(STR,$GET(CJ),$GET(LM))
+2 QUIT
+3 ;
+4 ;
LABMAP ;
+1 ;
+2 NEW DIERR,LRIEN,LRFDA,LRMSG
+3 SET LRIEN=$ORDER(^XMB(3.8,"B","LAB MAPPING",0))
+4 IF LRIEN<1
QUIT
+5 ; Set access levels
+6 SET LRIEN=LRIEN_","
+7 ; type
SET LRFDA(1,3.8,LRIEN,4)="PU"
+8 ; self enroll
SET LRFDA(1,3.8,LRIEN,7)="n"
+9 DO FILE^DIE("","LRFDA(1)","LRMSG")
+10 QUIT
+11 ;
+12 ;
MICHECK1 ; Task routine LR350M to check for bad nodes in MI subscript.
+1 ;
+2 ;
+3 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+4 DO BMES("*** Tasking post-install check of MI subscript in LAB DATA file ***")
+5 SET ZTRTN="EN^LR350M"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+6 SET ZTDESC="Check file #63 MI subscript (post-LR*5.2*350)"
+7 DO ^%ZTLOAD
+8 IF $GET(ZTSK)>0
DO BMES("*** Task #"_ZTSK_" created ***")
+9 IF $GET(ZTSK)<1
Begin DoDot:1
+10 DO BMES("*** Tasking FAILED ***")
+11 DO BMES("*** with error "_$GET(%ZTLOAD("ERROR"))_" ***")
End DoDot:1
+12 ;
+13 QUIT
+14 ;
+15 ;
MICHECK2 ; Task routine LRUW8 to check for bad antibiotic field definition in MI subscript.
+1 ;
+2 ;
+3 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+4 DO BMES("*** Tasking post-install check of MI Antibiotic Field Definitions in LAB DATA file ***")
+5 SET ZTRTN="KIDS^LRWU8"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+6 SET ZTDESC="Check file #63 MI Antibiotic Field Definitions (post-LR*5.2*350)"
+7 DO ^%ZTLOAD
+8 IF $GET(ZTSK)>0
DO BMES("*** Task #"_ZTSK_" created ***")
+9 IF $GET(ZTSK)<1
Begin DoDot:1
+10 DO BMES("*** Tasking FAILED ***")
+11 DO BMES("*** with error "_$GET(%ZTLOAD("ERROR"))_" ***")
End DoDot:1
+12 ;
+13 QUIT
LRWU9 ;Task LRWU9 to check for bad Chemistry test names
+1 ;
+2 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+3 ;
+4 SET ZTDESC="*** Tasking post-install check of bad test names"
+5 DO BMES^XPDUTL($$CJ^XLFSTR(ZTDESC,80))
+6 ;
+7 SET ZTRTN="KIDS^LRWU9"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+8 SET ZTDESC="Check file #63 for bad test Chemistry names."
+9 DO ^%ZTLOAD
+10 ;
+11 IF $GET(ZTSK)<1
Begin DoDot:1
+12 SET ZTDESC="*** Tasking FAILED ***"
+13 DO BMES^XPDUTL($$CJ^XLFSTR(ZTDESC,80))
+14 SET ZTDESC="*** with error "_$GET(%ZTLOAD("ERROR"))_" ***"
+15 DO BMES^XPDUTL($$CJ^XLFSTR(ZTDESC,80))
End DoDot:1
+16 ;
+17 QUIT
+18 ;
+19 ;
RINDXB61 ; Re-index "B" cross-reference of File #61 (as it changed from 30 to 80 chars)
+1 ;
+2 NEW DA,DIK,LRFMERTS
+3 ;
+4 SET LRFMERTS=1
+5 KILL ^LAB(61,"B")
+6 SET DIK="^LAB(61,"
+7 SET DIK(1)=".01^B"
+8 DO ENALL^DIK
+9 KILL DIK
+10 SET DIK="^LAB(61,"
+11 SET DIK(1)="6^B"
+12 DO ENALL^DIK
+13 ;
+14 QUIT
