LEX2027P ; ISL/KER - Pre/Post Install; 10/27/2003
;;2.0;LEXICON UTILITY;**27**;Sep 23, 1996
;
; External References
; DBIA 10086 HOME^%ZIS
; DBIA 2052 $$GET1^DID
; DBIA 2055 PRD^DILFD
; DBIA 10014 EN^DIU2
; DBIA 10141 BMES^XPDUTL
; DBIA 10141 MES^XPDUTL
;
Q
;
POST ; LEX*2.0*27 Post-Install
N LEXEDT S LEXEDT=$G(^LEXM(0,"CREATED")) D AFIL,IMP,CON,PRO,MSG
Q
AFIL ; Re-create cross-reference ^LEXC(757.9,"AFIL")
D BM^LEX2027(" Building Cross-Reference ^LEXC(757.9,""AFIL"")")
N DA,DIK S DIK="^LEXC(757.9," K ^LEXC(757.9,"AFIL")
S DA=0 F S DA=$O(^LEXC(757.9,DA)) Q:+DA=0 D IX1^DIK
Q
IMP ; Import Data from Routines
D BM^LEX2027(" Installing Data") D:$L($T(EN^LEX2027A)) EN^LEX2027A
D:$L($T(DATA^LEX2027A)) DATA^LEX2027A D:$L($T(DATA^LEX2027B)) DATA^LEX2027B
D:$L($T(DATA^LEX2027C)) DATA^LEX2027C D:$L($T(DATA^LEX2027D)) DATA^LEX2027D
Q:'$D(^%ZOSF("DEL")) S:$L($T(DATA^LEX2027A)) X="LEX2027A" X:$L($T(DATA^LEX2027A)) ^%ZOSF("DEL")
S:$L($T(DATA^LEX2027B)) X="LEX2027B" X:$L($T(DATA^LEX2027B)) ^%ZOSF("DEL")
S:$L($T(DATA^LEX2027C)) X="LEX2027C" X:$L($T(DATA^LEX2027C)) ^%ZOSF("DEL")
S:$L($T(DATA^LEX2027D)) X="LEX2027D" X:$L($T(DATA^LEX2027D)) ^%ZOSF("DEL")
Q
CON ; Conversion of data (Sep 30 Inactivation Date)
D BM^LEX2027(" Fixing Sep 30, 2003 Inactivation Date") W !," "
N FDA,CODEIEN,SUBIEN,CTR,ZZERR
S CODIEN=0,CTR=0 F S CODIEN=$O(^ICD0(CODIEN)) Q:+CODIEN=0 D
. S CTR=CTR+1 I CTR>1100 W "." S CTR=0
. Q:'$D(^ICD0(CODIEN,66,"B",3030930))
. S SUBIEN=$O(^ICD0(CODIEN,66,"B",3030930,""))
. K FDA S FDA(80.166,SUBIEN_","_CODIEN_",",.01)="@"
. D UPDATE^DIE(,"FDA",,"ZZERR")
. K FDA S FDA(80.166,"+1,"_CODIEN_",",.01)=3031001
. S FDA(80.166,"+1,"_CODIEN_",",.02)=0
. D UPDATE^DIE(,"FDA",,"ZZERR")
S CODIEN=0 F S CODIEN=$O(^ICD9(CODIEN)) Q:+CODIEN=0 D
. S CTR=CTR+1 I CTR>1100 W "." S CTR=0
. Q:'$D(^ICD9(CODIEN,66,"B",3030930))
. S SUBIEN=$O(^ICD9(CODIEN,66,"B",3030930,""))
. K FDA S FDA(80.066,SUBIEN_","_CODIEN_",",.01)="@"
. D UPDATE^DIE(,"FDA",,"ZZERR")
. K FDA S FDA(80.066,"+1,"_CODIEN_",",.01)=3031001
. S FDA(80.066,"+1,"_CODIEN_",",.02)=0
. D UPDATE^DIE(,"FDA",,"ZZERR")
S CODIEN=0 F S CODIEN=$O(^LEX(757.02,CODIEN)) Q:+CODIEN=0 D
. S CTR=CTR+1 I CTR>1100 W "." S CTR=0
. Q:'$D(^LEX(757.02,CODIEN,4,"B",3030930))
. S SUBIEN="" F S SUBIEN=$O(^LEX(757.02,CODIEN,4,"B",3030930,SUBIEN)) Q:SUBIEN="" D
. . K FDA S FDA(757.28,SUBIEN_","_CODIEN_",",.01)="@"
. . D UPDATE^DIE(,"FDA",,"ZZERR")
. K FDA S FDA(757.28,"+1,"_CODIEN_",",.01)=3031001
. S FDA(757.28,"+1,"_CODIEN_",",1)=0
. D UPDATE^DIE(,"FDA",,"ZZERR")
Q
PRO ; Force Protocol
N LEXSCHG,LEXPCALL S LEXSCHG(757,0)="",LEXSCHG(757.001,0)="",LEXSCHG(757.01,0)="",LEXSCHG(757.05,0)=""
S LEXSCHG(757.9,0)="",LEXSCHG(757.9,1)=80,LEXSCHG(757.9,2)=80.1,LEXSCHG(757.9,3)=81
S LEXSCHG(757.9,4)=81.3,LEXSCHG(757.9,"B",80,1)="",LEXSCHG(757.9,"B",80.1,2)=""
S LEXSCHG(757.9,"B",81,3)="",LEXSCHG(757.9,"B",81.3,4)=""
D:$L($T(NOTIFY^LEXXGI)) NOTIFY^LEXXGI
Q
MSG ; Send Installation Message
Q:+($G(DUZ))=0!($$NOTDEF^LEX2027($G(DUZ)))
D HOME^%ZIS N DIFROM,LEXLREV,LEXLAST,LEXBUILD,LEXIGHF,LEXSHORT
S LEXSHORT="" D IMP^LEX2027,SEND^LEXXST Q
;
PRE ; LEX*2.0*27 Pre-Install (N/A for patch 27)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2027P 3375 printed Sep 23, 2025@19:39:36 Page 2
LEX2027P ; ISL/KER - Pre/Post Install; 10/27/2003
+1 ;;2.0;LEXICON UTILITY;**27**;Sep 23, 1996
+2 ;
+3 ; External References
+4 ; DBIA 10086 HOME^%ZIS
+5 ; DBIA 2052 $$GET1^DID
+6 ; DBIA 2055 PRD^DILFD
+7 ; DBIA 10014 EN^DIU2
+8 ; DBIA 10141 BMES^XPDUTL
+9 ; DBIA 10141 MES^XPDUTL
+10 ;
+11 QUIT
+12 ;
POST ; LEX*2.0*27 Post-Install
+1 NEW LEXEDT
SET LEXEDT=$GET(^LEXM(0,"CREATED"))
DO AFIL
DO IMP
DO CON
DO PRO
DO MSG
+2 QUIT
AFIL ; Re-create cross-reference ^LEXC(757.9,"AFIL")
+1 DO BM^LEX2027(" Building Cross-Reference ^LEXC(757.9,""AFIL"")")
+2 NEW DA,DIK
SET DIK="^LEXC(757.9,"
KILL ^LEXC(757.9,"AFIL")
+3 SET DA=0
FOR
SET DA=$ORDER(^LEXC(757.9,DA))
if +DA=0
QUIT
DO IX1^DIK
+4 QUIT
IMP ; Import Data from Routines
+1 DO BM^LEX2027(" Installing Data")
if $LENGTH($TEXT(EN^LEX2027A))
DO EN^LEX2027A
+2 if $LENGTH($TEXT(DATA^LEX2027A))
DO DATA^LEX2027A
if $LENGTH($TEXT(DATA^LEX2027B))
DO DATA^LEX2027B
+3 if $LENGTH($TEXT(DATA^LEX2027C))
DO DATA^LEX2027C
if $LENGTH($TEXT(DATA^LEX2027D))
DO DATA^LEX2027D
+4 if '$DATA(^%ZOSF("DEL"))
QUIT
if $LENGTH($TEXT(DATA^LEX2027A))
SET X="LEX2027A"
if $LENGTH($TEXT(DATA^LEX2027A))
XECUTE ^%ZOSF("DEL")
+5 if $LENGTH($TEXT(DATA^LEX2027B))
SET X="LEX2027B"
if $LENGTH($TEXT(DATA^LEX2027B))
XECUTE ^%ZOSF("DEL")
+6 if $LENGTH($TEXT(DATA^LEX2027C))
SET X="LEX2027C"
if $LENGTH($TEXT(DATA^LEX2027C))
XECUTE ^%ZOSF("DEL")
+7 if $LENGTH($TEXT(DATA^LEX2027D))
SET X="LEX2027D"
if $LENGTH($TEXT(DATA^LEX2027D))
XECUTE ^%ZOSF("DEL")
+8 QUIT
CON ; Conversion of data (Sep 30 Inactivation Date)
+1 DO BM^LEX2027(" Fixing Sep 30, 2003 Inactivation Date")
WRITE !," "
+2 NEW FDA,CODEIEN,SUBIEN,CTR,ZZERR
+3 SET CODIEN=0
SET CTR=0
FOR
SET CODIEN=$ORDER(^ICD0(CODIEN))
if +CODIEN=0
QUIT
Begin DoDot:1
+4 SET CTR=CTR+1
IF CTR>1100
WRITE "."
SET CTR=0
+5 if '$DATA(^ICD0(CODIEN,66,"B",3030930))
QUIT
+6 SET SUBIEN=$ORDER(^ICD0(CODIEN,66,"B",3030930,""))
+7 KILL FDA
SET FDA(80.166,SUBIEN_","_CODIEN_",",.01)="@"
+8 DO UPDATE^DIE(,"FDA",,"ZZERR")
+9 KILL FDA
SET FDA(80.166,"+1,"_CODIEN_",",.01)=3031001
+10 SET FDA(80.166,"+1,"_CODIEN_",",.02)=0
+11 DO UPDATE^DIE(,"FDA",,"ZZERR")
End DoDot:1
+12 SET CODIEN=0
FOR
SET CODIEN=$ORDER(^ICD9(CODIEN))
if +CODIEN=0
QUIT
Begin DoDot:1
+13 SET CTR=CTR+1
IF CTR>1100
WRITE "."
SET CTR=0
+14 if '$DATA(^ICD9(CODIEN,66,"B",3030930))
QUIT
+15 SET SUBIEN=$ORDER(^ICD9(CODIEN,66,"B",3030930,""))
+16 KILL FDA
SET FDA(80.066,SUBIEN_","_CODIEN_",",.01)="@"
+17 DO UPDATE^DIE(,"FDA",,"ZZERR")
+18 KILL FDA
SET FDA(80.066,"+1,"_CODIEN_",",.01)=3031001
+19 SET FDA(80.066,"+1,"_CODIEN_",",.02)=0
+20 DO UPDATE^DIE(,"FDA",,"ZZERR")
End DoDot:1
+21 SET CODIEN=0
FOR
SET CODIEN=$ORDER(^LEX(757.02,CODIEN))
if +CODIEN=0
QUIT
Begin DoDot:1
+22 SET CTR=CTR+1
IF CTR>1100
WRITE "."
SET CTR=0
+23 if '$DATA(^LEX(757.02,CODIEN,4,"B",3030930))
QUIT
+24 SET SUBIEN=""
FOR
SET SUBIEN=$ORDER(^LEX(757.02,CODIEN,4,"B",3030930,SUBIEN))
if SUBIEN=""
QUIT
Begin DoDot:2
+25 KILL FDA
SET FDA(757.28,SUBIEN_","_CODIEN_",",.01)="@"
+26 DO UPDATE^DIE(,"FDA",,"ZZERR")
End DoDot:2
+27 KILL FDA
SET FDA(757.28,"+1,"_CODIEN_",",.01)=3031001
+28 SET FDA(757.28,"+1,"_CODIEN_",",1)=0
+29 DO UPDATE^DIE(,"FDA",,"ZZERR")
End DoDot:1
+30 QUIT
PRO ; Force Protocol
+1 NEW LEXSCHG,LEXPCALL
SET LEXSCHG(757,0)=""
SET LEXSCHG(757.001,0)=""
SET LEXSCHG(757.01,0)=""
SET LEXSCHG(757.05,0)=""
+2 SET LEXSCHG(757.9,0)=""
SET LEXSCHG(757.9,1)=80
SET LEXSCHG(757.9,2)=80.1
SET LEXSCHG(757.9,3)=81
+3 SET LEXSCHG(757.9,4)=81.3
SET LEXSCHG(757.9,"B",80,1)=""
SET LEXSCHG(757.9,"B",80.1,2)=""
+4 SET LEXSCHG(757.9,"B",81,3)=""
SET LEXSCHG(757.9,"B",81.3,4)=""
+5 if $LENGTH($TEXT(NOTIFY^LEXXGI))
DO NOTIFY^LEXXGI
+6 QUIT
MSG ; Send Installation Message
+1 if +($GET(DUZ))=0!($$NOTDEF^LEX2027($GET(DUZ)))
QUIT
+2 DO HOME^%ZIS
NEW DIFROM,LEXLREV,LEXLAST,LEXBUILD,LEXIGHF,LEXSHORT
+3 SET LEXSHORT=""
DO IMP^LEX2027
DO SEND^LEXXST
QUIT
+4 ;
PRE ; LEX*2.0*27 Pre-Install (N/A for patch 27)
+1 QUIT
