AUM101EN ;IHS/ASDST/DMJ,SDR,GTH - ICD 9 CODES FOR FY 2010 ; [ 09/17/2002 12:40 PM ]
;;10.2;TABLE MAINTENANCE;;MAR 09, 2010
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
;
S X=$P(^VA(200,DUZ,0),U)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_".",IOM)
;
S XPDQUIT=0,AUMQUIT=0
I $$VCHK("XU","8.0",2)
I $$VCHK("DI","22.0",2)
;
I $$VCHK("AUM","9.1",2)
S X=$$LAST("ICD UPDATE","9.1")
I $P(X,U)'=4 W !,$$CJ^XLFSTR("AUM*9.1*4 NOT INSTALLED",IOM) S XPDQUIT=2 ;need AUM*9.1*4 installed
;
NEW DA,DIC
S X="AUM",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AUM")) D
.W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)
.W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
.D SORRY(2)
.Q
;
I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
D HELP^XBHELP("INTROE","AZHBENV")
;
I $G(XPDENV)=1 D
.; The following line prevents the "Disable Options..." and "Move
.; Routines..." questions from being asked during the install.
.S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
.D HELP^XBHELP("INTROI","AZHBENV")
.Q
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
Q
PRE ;
S AUMK="^ICD9(""BA"")"
K @AUMK
S AUMK="^ICD9(""AB"")"
K @AUMK
D ^XBFMK
S DIK="^ICD9("
S DIK(1)=".01"
D ENALL^DIK
;
S AUMK="^ICD0(""BA"")"
K @AUMK
S AUMK="^ICD0(""AB"")"
K @AUMK
D ^XBFMK
S DIK="^ICD0("
S DIK(1)=".01"
D ENALL^DIK
;
D CLEANALL^AUMPREX ;remove control characters
;
D RSLT^AUM91RL1("Removing data from ICD EXPANDED field...")
D START^AUM91P2 ;remove data from ICD EXPANDED field
;
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
;
VCHK(AUMPRE,AUMVER,AUMQUIT) ; Check versions needed.
;
NEW AUMV
S AUMV=$$VERSION^XPDUTL(AUMPRE)
W !,$$CJ^XLFSTR("Need at least "_AUMPRE_" v "_AUMVER_"....."_AUMPRE_" v "_AUMV_" Present",IOM)
I AUMV<AUMVER KILL DIFQ S XPDQUIT=AUMQUIT D SORRY(XPDQUIT) Q 0
Q 1
;
LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
; Patch includes Seq # if Released
N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1
S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1
S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1
S LATEST=-1,PATCH=-1,SUBIEN=0
F S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0 D
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U)
Q PATCH_U_LATEST
;
INTROE ; Intro text during KIDS Environment check.
;;This is the annual update to the ICD files. There are modifications,
;;inactivations, and new entries to both files.
;;###
;
INTROI ; Intro text during KIDS Install.
;;If you run interactively, results will be displayed on your screen,
;;and recorded in the entry in the INSTALL file.
;;If you queue to TaskMan, remember not to Q to the HOME device.
;;###
;
AUM101EN ;IHS/ASDST/DMJ,SDR,GTH - ICD 9 CODES FOR FY 2010 ; [ 09/17/2002 12:40 PM ]
+1 ;;10.2;TABLE MAINTENANCE;;MAR 09, 2010
+2 ;
+3 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+4 ;
+5 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+6 ;
+7 SET X=$PIECE(^VA(200,DUZ,0),U)
+8 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+9 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_".",IOM)
+10 ;
+11 SET XPDQUIT=0
SET AUMQUIT=0
+12 IF $$VCHK("XU","8.0",2)
+13 IF $$VCHK("DI","22.0",2)
+14 ;
+15 IF $$VCHK("AUM","9.1",2)
+16 SET X=$$LAST("ICD UPDATE","9.1")
+17 ;need AUM*9.1*4 installed
IF $PIECE(X,U)'=4
WRITE !,$$CJ^XLFSTR("AUM*9.1*4 NOT INSTALLED",IOM)
SET XPDQUIT=2
+18 ;
+19 NEW DA,DIC
+20 SET X="AUM"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+21 DO IX^DIC
+22 IF Y<0
IF $DATA(^DIC(9.4,"C","AUM"))
Begin DoDot:1
+23 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)
+24 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+25 DO SORRY(2)
+26 QUIT
End DoDot:1
+27 ;
+28 IF $GET(XPDQUIT)
WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
QUIT
+29 ;
+30 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+31 DO HELP^XBHELP("INTROE","AZHBENV")
+32 ;
+33 IF $GET(XPDENV)=1
Begin DoDot:1
+34 ; The following line prevents the "Disable Options..." and "Move
+35 ; Routines..." questions from being asked during the install.
+36 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+37 DO HELP^XBHELP("INTROI","AZHBENV")
+38 QUIT
End DoDot:1
+39 ;
+40 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
QUIT
+41 QUIT
PRE ;
+1 SET AUMK="^ICD9(""BA"")"
+2 KILL @AUMK
+3 SET AUMK="^ICD9(""AB"")"
+4 KILL @AUMK
+5 DO ^XBFMK
+6 SET DIK="^ICD9("
+7 SET DIK(1)=".01"
+8 DO ENALL^DIK
+9 ;
+10 SET AUMK="^ICD0(""BA"")"
+11 KILL @AUMK
+12 SET AUMK="^ICD0(""AB"")"
+13 KILL @AUMK
+14 DO ^XBFMK
+15 SET DIK="^ICD0("
+16 SET DIK(1)=".01"
+17 DO ENALL^DIK
+18 ;
+19 ;remove control characters
DO CLEANALL^AUMPREX
+20 ;
+21 DO RSLT^AUM91RL1("Removing data from ICD EXPANDED field...")
+22 ;remove data from ICD EXPANDED field
DO START^AUM91P2
+23 ;
+24 QUIT
+25 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+4 QUIT
+5 ;
VCHK(AUMPRE,AUMVER,AUMQUIT) ; Check versions needed.
+1 ;
+2 NEW AUMV
+3 SET AUMV=$$VERSION^XPDUTL(AUMPRE)
+4 WRITE !,$$CJ^XLFSTR("Need at least "_AUMPRE_" v "_AUMVER_"....."_AUMPRE_" v "_AUMV_" Present",IOM)
+5 IF AUMV<AUMVER
KILL DIFQ
SET XPDQUIT=AUMQUIT
DO SORRY(XPDQUIT)
QUIT 0
+6 QUIT 1
+7 ;
LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
+1 ; Patch includes Seq # if Released
+2 NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
+3 IF $GET(VER)=""
SET VER=$$VERSION^XPDUTL(PKG)
IF 'VER
QUIT -1
+4 SET PKGIEN=$ORDER(^DIC(9.4,"B",PKG,""))
IF 'PKGIEN
QUIT -1
+5 SET VERIEN=$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))
IF 'VERIEN
QUIT -1
+6 SET LATEST=-1
SET PATCH=-1
SET SUBIEN=0
+7 FOR
SET SUBIEN=$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN))
IF SUBIEN'>0
QUIT
Begin DoDot:1
+8 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST
SET LATEST=$PIECE(^(0),U,2)
SET PATCH=$PIECE(^(0),U)
+9 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST
IF $PIECE(^(0),U)>PATCH
SET PATCH=$PIECE(^(0),U)
End DoDot:1
+10 QUIT PATCH_U_LATEST
+11 ;
INTROE ; Intro text during KIDS Environment check.
+1 ;;This is the annual update to the ICD files. There are modifications,
+2 ;;inactivations, and new entries to both files.
+3 ;;###
+4 ;
INTROI ; Intro text during KIDS Install.
+1 ;;If you run interactively, results will be displayed on your screen,
+2 ;;and recorded in the entry in the INSTALL file.
+3 ;;If you queue to TaskMan, remember not to Q to the HOME device.
+4 ;;###
+5 ;
