ICD1857P ;ISL/KER - ICD*18.0*57 Pre/Post-Install ;04/21/2014
;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7
;
;
; Global Variables
; ^%ZOSF("UCI") ICR 10096
; ^%ZOSF("UCICHECK") ICR 10096
; ^TMP("LEX*2.0*80" SACC 2.3.2.5.1
;
; External References
; $$VERSION^%ZOSV ICR 10097
; FIELD^DID ICR 2052
; EN^DIU2 ICR 10014
; $$UP^XLFSTR ICR 10104
; $$NETNAME^XMXUTIL ICR 2734
; BMES^XPDUTL ICR 10141
; MES^XPDUTL ICR 10141
;
; Local Variables NEWed or KILLed by KIDS
; XPDNOQUE
;
; SACC Exemption
;
; $ZU(68,28,n) May 9, 2013
;
; Clinical Lexicon requests an exemption to use $ZU in
; the pre and post install routines for future LEX
; patches. This exemption will expire with the release
; of LEX 3.0. Calling $ZU(68,28,0) to enable an
; unsubscripted global kill prior to installing the
; latest ICD files leaves the possibility that a global
; will be killed by another process during a lengthy
; installation. Placing the call in the pre (or post)
; install, instead of making the call manually before
; and after the install, cuts this window down to a
; few seconds.
;
Q
PRE ; ICD*18.0*57 Pre-Install
S XPDNOQUE=1 I $D(ZTQUEUED) S XPDABORT=1,XPDQUIT=1,XPDQUIT("ICD*18.0*57")=1,XPDQUIT("LEX*2.0*80")=1 Q
Q:+($$UOK)'>0 D DEL
Q
POST ; ICD*18.0*57 Post-Install
S XPDNOQUE=1 I $D(ZTQUEUED) S XPDABORT=1,XPDQUIT=1,XPDQUIT("ICD*18.0*57")=1,XPDQUIT("LEX*2.0*80")=1 Q
D N0
Q
;
; Miscellaneous
N0 ; Node 0
D BM(" Updating ICD files")
N ICD0,ICD9,ICDI,ICDL,ICDM,ICDT
K ICD9,ICDM D FIELD^DID(80,.01,,"LABEL","ICD9","ICDM")
K ICD0,ICDM D FIELD^DID(80.1,.01,,"LABEL","ICD0","ICDM")
D M(" ICD DIAGNOSIS file #80")
I $L($G(ICD9("LABEL"))),('$D(^ICD9(0))) D
. N ICDL,ICDT,ICDI S ICDL="",ICDT=0,ICDI=0
. F S ICDI=$O(^ICD9(ICDI)) Q:+ICDI'>0 S ICDL=ICDI,ICDT=ICDT+1
. S ^ICD9(0)="ICD DIAGNOSIS^80OI^"_ICDL_"^"_ICDT
D M(" ICD OPERATION/PROCEDURE file #80.1")
I $L($G(ICD0("LABEL"))),('$D(^ICD0(0))) D
. N ICDL,ICDT,ICDI S ICDL="",ICDT=0,ICDI=0
. F S ICDI=$O(^ICD0(ICDI)) Q:+ICDI'>0 S ICDL=ICDI,ICDT=ICDT+1
. S ^ICD0(0)="ICD OPERATION/PROCEDURE^80.1OI^"_ICDL_"^"_ICDT
Q
UOK(X) ; UCI Ok for Install
N X,Y S X=$$NETNAME^XMXUTIL(.5) Q:X["LEXDEV1.FO-BAYPINES" 0
X ^%ZOSF("UCI") Q:$G(Y)["LEXDEV1" 0 S X="LEXDEV1" X ^%ZOSF("UCICHECK") Q:$G(X)=$G(Y) 0
Q 1
DEL ; Delete ICD Data Dictionaries and Globals
Q:+($$UOK)'>0 N DIU,ICDMUM S ICDMUM=$$UP^XLFSTR($$VERSION^%ZOSV(1))
D BM(" Deleting the Data Dictionary and Data for:")
D M(" ICD DIAGNOSIS file #80") H 1
S DIU="^ICD9(",DIU(0)=$S($D(^TMP("LEX*2.0*80",$J,"NODATA")):"T",1:"DT")
S:ICDMUM["CACHE" X=$ZU(68,28,0) D EN^DIU2 S:ICDMUM["CACHE" X=$ZU(68,28,1) W " done"
D M(" ICD OPERATION/PROCEDURE file #80.1") H 1
S DIU="^ICD0(",DIU(0)=$S($D(^TMP("LEX*2.0*80",$J,"NODATA")):"T",1:"DT")
S:ICDMUM["CACHE" X=$ZU(68,28,0) D EN^DIU2 S:ICDMUM["CACHE" X=$ZU(68,28,1) W " done"
Q
M(X) ; Blank/Text
D MES^XPDUTL($G(X)) Q
BM(X) ; Blank/Text
D BMES^XPDUTL($G(X)) Q
TRIM(X) ; Trim Spaces
S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
Q X
CLR ; Clear Variables not NEWed
N ZTQUEUED,XPDABORT,XPDQUIT,XPDQUIT
Q
ICD1857P ;ISL/KER - ICD*18.0*57 Pre/Post-Install ;04/21/2014
+1 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7
+2 ;
+3 ;
+4 ; Global Variables
+5 ; ^%ZOSF("UCI") ICR 10096
+6 ; ^%ZOSF("UCICHECK") ICR 10096
+7 ; ^TMP("LEX*2.0*80" SACC 2.3.2.5.1
+8 ;
+9 ; External References
+10 ; $$VERSION^%ZOSV ICR 10097
+11 ; FIELD^DID ICR 2052
+12 ; EN^DIU2 ICR 10014
+13 ; $$UP^XLFSTR ICR 10104
+14 ; $$NETNAME^XMXUTIL ICR 2734
+15 ; BMES^XPDUTL ICR 10141
+16 ; MES^XPDUTL ICR 10141
+17 ;
+18 ; Local Variables NEWed or KILLed by KIDS
+19 ; XPDNOQUE
+20 ;
+21 ; SACC Exemption
+22 ;
+23 ; $ZU(68,28,n) May 9, 2013
+24 ;
+25 ; Clinical Lexicon requests an exemption to use $ZU in
+26 ; the pre and post install routines for future LEX
+27 ; patches. This exemption will expire with the release
+28 ; of LEX 3.0. Calling $ZU(68,28,0) to enable an
+29 ; unsubscripted global kill prior to installing the
+30 ; latest ICD files leaves the possibility that a global
+31 ; will be killed by another process during a lengthy
+32 ; installation. Placing the call in the pre (or post)
+33 ; install, instead of making the call manually before
+34 ; and after the install, cuts this window down to a
+35 ; few seconds.
+36 ;
+37 QUIT
PRE ; ICD*18.0*57 Pre-Install
+1 SET XPDNOQUE=1
IF $DATA(ZTQUEUED)
SET XPDABORT=1
SET XPDQUIT=1
SET XPDQUIT("ICD*18.0*57")=1
SET XPDQUIT("LEX*2.0*80")=1
QUIT
+2 IF +($$UOK)'>0
QUIT
DO DEL
+3 QUIT
POST ; ICD*18.0*57 Post-Install
+1 SET XPDNOQUE=1
IF $DATA(ZTQUEUED)
SET XPDABORT=1
SET XPDQUIT=1
SET XPDQUIT("ICD*18.0*57")=1
SET XPDQUIT("LEX*2.0*80")=1
QUIT
+2 DO N0
+3 QUIT
+4 ;
+5 ; Miscellaneous
N0 ; Node 0
+1 DO BM(" Updating ICD files")
+2 NEW ICD0,ICD9,ICDI,ICDL,ICDM,ICDT
+3 KILL ICD9,ICDM
DO FIELD^DID(80,.01,,"LABEL","ICD9","ICDM")
+4 KILL ICD0,ICDM
DO FIELD^DID(80.1,.01,,"LABEL","ICD0","ICDM")
+5 DO M(" ICD DIAGNOSIS file #80")
+6 IF $LENGTH($GET(ICD9("LABEL")))
IF ('$DATA(^ICD9(0)))
Begin DoDot:1
+7 NEW ICDL,ICDT,ICDI
SET ICDL=""
SET ICDT=0
SET ICDI=0
+8 FOR
SET ICDI=$ORDER(^ICD9(ICDI))
IF +ICDI'>0
QUIT
SET ICDL=ICDI
SET ICDT=ICDT+1
+9 SET ^ICD9(0)="ICD DIAGNOSIS^80OI^"_ICDL_"^"_ICDT
End DoDot:1
+10 DO M(" ICD OPERATION/PROCEDURE file #80.1")
+11 IF $LENGTH($GET(ICD0("LABEL")))
IF ('$DATA(^ICD0(0)))
Begin DoDot:1
+12 NEW ICDL,ICDT,ICDI
SET ICDL=""
SET ICDT=0
SET ICDI=0
+13 FOR
SET ICDI=$ORDER(^ICD0(ICDI))
IF +ICDI'>0
QUIT
SET ICDL=ICDI
SET ICDT=ICDT+1
+14 SET ^ICD0(0)="ICD OPERATION/PROCEDURE^80.1OI^"_ICDL_"^"_ICDT
End DoDot:1
+15 QUIT
UOK(X) ; UCI Ok for Install
+1 NEW X,Y
SET X=$$NETNAME^XMXUTIL(.5)
IF X["LEXDEV1.FO-BAYPINES"
QUIT 0
+2 XECUTE ^%ZOSF("UCI")
IF $GET(Y)["LEXDEV1"
QUIT 0
SET X="LEXDEV1"
XECUTE ^%ZOSF("UCICHECK")
IF $GET(X)=$GET(Y)
QUIT 0
+3 QUIT 1
DEL ; Delete ICD Data Dictionaries and Globals
+1 IF +($$UOK)'>0
QUIT
NEW DIU,ICDMUM
SET ICDMUM=$$UP^XLFSTR($$VERSION^%ZOSV(1))
+2 DO BM(" Deleting the Data Dictionary and Data for:")
+3 DO M(" ICD DIAGNOSIS file #80")
HANG 1
+4 SET DIU="^ICD9("
SET DIU(0)=$SELECT($DATA(^TMP("LEX*2.0*80",$JOB,"NODATA")):"T",1:"DT")
+5 IF ICDMUM["CACHE"
SET X=$ZU(68,28,0)
DO EN^DIU2
IF ICDMUM["CACHE"
SET X=$ZU(68,28,1)
WRITE " done"
+6 DO M(" ICD OPERATION/PROCEDURE file #80.1")
HANG 1
+7 SET DIU="^ICD0("
SET DIU(0)=$SELECT($DATA(^TMP("LEX*2.0*80",$JOB,"NODATA")):"T",1:"DT")
+8 IF ICDMUM["CACHE"
SET X=$ZU(68,28,0)
DO EN^DIU2
IF ICDMUM["CACHE"
SET X=$ZU(68,28,1)
WRITE " done"
+9 QUIT
M(X) ; Blank/Text
+1 DO MES^XPDUTL($GET(X))
QUIT
BM(X) ; Blank/Text
+1 DO BMES^XPDUTL($GET(X))
QUIT
TRIM(X) ; Trim Spaces
+1 SET X=$GET(X)
FOR
IF $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 FOR
IF $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+3 QUIT X
CLR ; Clear Variables not NEWed
+1 NEW ZTQUEUED,XPDABORT,XPDQUIT,XPDQUIT
+2 QUIT
