ICD186E ;DLS/DEK- ICD Env. Check; 04/28/2003
;;18.0;DRG Grouper;**6**;Oct 20, 2000
;
; External References
; DBIA 10141 $$PATCH^XPDUTL
; DBIA 10141 BMES^XPDUTL
; DBIA 10141 MES^XPDUTL
;
ENVCHK ; Check Environment for needed vars.
N PATCH,BUILD
S XPDABORT="",PATCH="ICD*18.0*5",BUILD="ICD*18.0*6"
I '$$PATCH^XPDUTL(PATCH) D Q
. D BM(PATCH_" is required and MUST be installed prior to this patch."),ABRT
I +($$CPD)'>0,+($G(XPDENV))=0 D
. I +($G(^LEXM(0,"CHECKSUM")))'=70183825959 D
. . D BM("Global ^LEXM either not found or incomplete."),ABRT
D:+($G(XPDABORT))'>0 PROGCHK(.XPDABORT)
I $G(XPDABORT)="" K XPDABORT D OK
Q
PROGCHK(XPDABORT) ; Check for Programmer
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
. D BM("Programming variables are not set up properly."),ABRT
Q
ABRT ; Abort - All or nothing
S XPDABORT=1,XPDQUIT=1,XPDQUIT("LEX*2.0*25")=1
S XPDQUIT("ICD*18.0*6")=1,XPDQUIT("ICPT*6.0*14")=1
S XPDQUIT("CSV UTIL 1.0")=1
Q
OK ; Environment is Ok
Q:+($G(XPDENV))>0
D BM((" Environment for patch/build "_BUILD_" is ok")),M(" ")
Q
;
POST ; Post-Install - Rebuild Indexes
N ZTRTN,ZTDESC,ZTSK,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ICD1,ICD2 S (ICD1,ICD2)=0
S ZTRTN="ICDD^ICD186E",ZTDESC="Re-Index file #80"
S ZTIO="",ZTDTH=$H K ZTSK D ^%ZTLOAD,HOME^%ZIS
S:+($G(ZTSK))>0 ICD1=+($G(ZTSK))
S ZTRTN="ICDP^ICD186E",ZTDESC="Re-Index file #80.1"
S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS
S:+($G(ZTSK))>0 ICD2=+($G(ZTSK))
I ICD1>0,ICD2'>0 D BM(("Task "_+ICD1_" to rebuild indexes for ICD Diagnosis file #80 started"))
I ICD1'>0,ICD2>0 D BM(("Task "_+ICD2_" to rebuild indexes for ICD Procedure file #80.1 started"))
I ICD1>0,ICD2>0 D
. D BM(("Task "_+ICD1_" to rebuild indexes for ICD Diagnosis file #80 started"))
. D M(("Task "_+ICD2_" to rebuild indexes for ICD Procedure file #80.1 started"))
K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ICD1,ICD2
Q
ICDD ; ICD9( Diagnosis
S:$D(ZTQUEUED) ZTREQ="@"
N DA,DIK S U="^",DT=$$DT^XLFDT,DIK="^ICD9(",DA=0
F S DA=$O(^ICD9(DA)) Q:+DA=0 K ^ICD9(DA,66,"B")
K ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT")
K ^ICD9("BA"),^ICD9("D")
D IXALL^DIK
Q
ICDP ; ICD0( Procedure
S:$D(ZTQUEUED) ZTREQ="@"
N DA,DIK S U="^",DT=$$DT^XLFDT,DIK="^ICD0(",DA=0
F S DA=$O(^ICD0(DA)) Q:+DA=0 K ^ICD0(DA,66,"B")
K ^ICD0("AB"),^ICD0("ACT"),^ICD0("BA"),^ICD0("D")
K ^ICD0("E") D IXALL^DIK
Q
CPD(X) ; Check Current Patched Data is installed
Q:$D(^LEX(757.1,"B",180595,257762))&('$D(^LEX(757.02,"B",322162,3296))) 1
Q 0
;
; Miscellaneous
BM(X) ; Blank Line with Message
S X=" "_$G(X) D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q
M(X) ; Message
S X=" "_$G(X) D:$D(XPDNM) MES^XPDUTL($G(X)) W:'$D(XPDNM) !,$G(X) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD186E 2834 printed Apr 09, 2024@20:52:56 Page 2
ICD186E ;DLS/DEK- ICD Env. Check; 04/28/2003
+1 ;;18.0;DRG Grouper;**6**;Oct 20, 2000
+2 ;
+3 ; External References
+4 ; DBIA 10141 $$PATCH^XPDUTL
+5 ; DBIA 10141 BMES^XPDUTL
+6 ; DBIA 10141 MES^XPDUTL
+7 ;
ENVCHK ; Check Environment for needed vars.
+1 NEW PATCH,BUILD
+2 SET XPDABORT=""
SET PATCH="ICD*18.0*5"
SET BUILD="ICD*18.0*6"
+3 IF '$$PATCH^XPDUTL(PATCH)
Begin DoDot:1
+4 DO BM(PATCH_" is required and MUST be installed prior to this patch.")
DO ABRT
End DoDot:1
QUIT
+5 IF +($$CPD)'>0
IF +($GET(XPDENV))=0
Begin DoDot:1
+6 IF +($GET(^LEXM(0,"CHECKSUM")))'=70183825959
Begin DoDot:2
+7 DO BM("Global ^LEXM either not found or incomplete.")
DO ABRT
End DoDot:2
End DoDot:1
+8 if +($GET(XPDABORT))'>0
DO PROGCHK(.XPDABORT)
+9 IF $GET(XPDABORT)=""
KILL XPDABORT
DO OK
+10 QUIT
PROGCHK(XPDABORT) ; Check for Programmer
+1 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+2 DO BM("Programming variables are not set up properly.")
DO ABRT
End DoDot:1
+3 QUIT
ABRT ; Abort - All or nothing
+1 SET XPDABORT=1
SET XPDQUIT=1
SET XPDQUIT("LEX*2.0*25")=1
+2 SET XPDQUIT("ICD*18.0*6")=1
SET XPDQUIT("ICPT*6.0*14")=1
+3 SET XPDQUIT("CSV UTIL 1.0")=1
+4 QUIT
OK ; Environment is Ok
+1 if +($GET(XPDENV))>0
QUIT
+2 DO BM((" Environment for patch/build "_BUILD_" is ok"))
DO M(" ")
+3 QUIT
+4 ;
POST ; Post-Install - Rebuild Indexes
+1 NEW ZTRTN,ZTDESC,ZTSK,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ICD1,ICD2
SET (ICD1,ICD2)=0
+2 SET ZTRTN="ICDD^ICD186E"
SET ZTDESC="Re-Index file #80"
+3 SET ZTIO=""
SET ZTDTH=$HOROLOG
KILL ZTSK
DO ^%ZTLOAD
DO HOME^%ZIS
+4 if +($GET(ZTSK))>0
SET ICD1=+($GET(ZTSK))
+5 SET ZTRTN="ICDP^ICD186E"
SET ZTDESC="Re-Index file #80.1"
+6 SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
DO HOME^%ZIS
+7 if +($GET(ZTSK))>0
SET ICD2=+($GET(ZTSK))
+8 IF ICD1>0
IF ICD2'>0
DO BM(("Task "_+ICD1_" to rebuild indexes for ICD Diagnosis file #80 started"))
+9 IF ICD1'>0
IF ICD2>0
DO BM(("Task "_+ICD2_" to rebuild indexes for ICD Procedure file #80.1 started"))
+10 IF ICD1>0
IF ICD2>0
Begin DoDot:1
+11 DO BM(("Task "_+ICD1_" to rebuild indexes for ICD Diagnosis file #80 started"))
+12 DO M(("Task "_+ICD2_" to rebuild indexes for ICD Procedure file #80.1 started"))
End DoDot:1
+13 KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ICD1,ICD2
+14 QUIT
ICDD ; ICD9( Diagnosis
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW DA,DIK
SET U="^"
SET DT=$$DT^XLFDT
SET DIK="^ICD9("
SET DA=0
+3 FOR
SET DA=$ORDER(^ICD9(DA))
if +DA=0
QUIT
KILL ^ICD9(DA,66,"B")
+4 KILL ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT")
+5 KILL ^ICD9("BA"),^ICD9("D")
+6 DO IXALL^DIK
+7 QUIT
ICDP ; ICD0( Procedure
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW DA,DIK
SET U="^"
SET DT=$$DT^XLFDT
SET DIK="^ICD0("
SET DA=0
+3 FOR
SET DA=$ORDER(^ICD0(DA))
if +DA=0
QUIT
KILL ^ICD0(DA,66,"B")
+4 KILL ^ICD0("AB"),^ICD0("ACT"),^ICD0("BA"),^ICD0("D")
+5 KILL ^ICD0("E")
DO IXALL^DIK
+6 QUIT
CPD(X) ; Check Current Patched Data is installed
+1 if $DATA(^LEX(757.1,"B",180595,257762))&('$DATA(^LEX(757.02,"B",322162,3296)))
QUIT 1
+2 QUIT 0
+3 ;
+4 ; Miscellaneous
BM(X) ; Blank Line with Message
+1 SET X=" "_$GET(X)
if $DATA(XPDNM)
DO BMES^XPDUTL($GET(X))
if '$DATA(XPDNM)
WRITE !!,$GET(X)
QUIT
M(X) ; Message
+1 SET X=" "_$GET(X)
if $DATA(XPDNM)
DO MES^XPDUTL($GET(X))
if '$DATA(XPDNM)
WRITE !,$GET(X)
QUIT
