Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AUM111EN

AUM111EN.m

Go to the documentation of this file. 
  1. AUM111EN ;IHS/ASDST/RNB - ICD 9 CODES FOR FY 2012 ; [ 09/09/2010  8:30 AM ]
  1.  ;;12.0;TABLE MAINTENANCE;;SEP 27,2011
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
  1.  ;
  1.  S X=$P(^VA(200,DUZ,0),U)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_".",IOM)
  1.  ;
  1.  S XPDQUIT=0,AUMQUIT=0
  1.  I $$VCHK("XU","8.0",2)
  1.  I $$VCHK("DI","22.0",2)
  1.  ;
  1.  I $$VCHK("AUM","11.0",2)
  1.  ;;S X=$$LAST("ICD UPDATE","11.0")
  1.  ;;I $P(X,U)'=4 W !,$$CJ^XLFSTR("AUM 10.2 NOT INSTALLED",IOM) S XPDQUIT=2  ;need AUM 10.2 installed
  1.  ;
  1.  NEW DA,DIC
  1.  S X="AUM",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","AUM")) D
  1.  .W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUM"" prefix.",IOM)
  1.  .W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
  1.  .D SORRY(2)
  1.  .Q
  1.  ;
  1.  I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  D HELP^XBHELP("INTROE","AZHBENV")
  1.  ;
  1.  I $G(XPDENV)=1 D
  1.  .; The following line prevents the "Disable Options..." and "Move
  1.  .; Routines..." questions from being asked during the install.
  1.  .S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  .D HELP^XBHELP("INTROI","AZHBENV")
  1.  .Q
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
  1.  Q
  1. PRE ;
  1.  S AUMK="^ICD9(""BA"")"
  1.  K @AUMK
  1.  S AUMK="^ICD9(""AB"")"
  1.  K @AUMK
  1.  D ^XBFMK
  1.  S DIK="^ICD9("
  1.  S DIK(1)=".01"
  1.  D ENALL^DIK
  1.  ;
  1.  S AUMK="^ICD0(""BA"")"
  1.  K @AUMK
  1.  S AUMK="^ICD0(""AB"")"
  1.  K @AUMK
  1.  D ^XBFMK
  1.  S DIK="^ICD0("
  1.  S DIK(1)=".01"
  1.  D ENALL^DIK
  1.  ;
  1.  ;D CLEANALL^AUMPREX  ;remove control characters
  1.  D CLEANALL^AUM111PX
  1.  ;
  1.  D RSLT^AUM91RL1("Removing data from ICD EXPANDED field...")
  1.  D START^AUM91P2  ;remove data from ICD EXPANDED field
  1.  ;
  1.  Q
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;
  1. VCHK(AUMPRE,AUMVER,AUMQUIT) ; Check versions needed.
  1.  ;  
  1.  NEW AUMV
  1.  S AUMV=$$VERSION^XPDUTL(AUMPRE)
  1.  W !,$$CJ^XLFSTR("Need at least "_AUMPRE_" v "_AUMVER_"....."_AUMPRE_" v "_AUMV_" Present",IOM)
  1.  I AUMV<AUMVER KILL DIFQ S XPDQUIT=AUMQUIT D SORRY(XPDQUIT) Q 0
  1.  Q 1
  1.  ;
  1. LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
  1.  ;        Patch includes Seq # if Released
  1.  N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
  1.  I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1
  1.  S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1
  1.  S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1
  1.  S LATEST=-1,PATCH=-1,SUBIEN=0
  1.  F  S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0  D
  1.  . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
  1.  . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U)
  1.  Q PATCH_U_LATEST
  1.  ;
  1. INTROE ; Intro text during KIDS Environment check.
  1.  ;;This is the annual update to the ICD files.  There are modifications,
  1.  ;;inactivations, and new entries to both files.
  1.  ;;###
  1.  ;
  1. INTROI ; Intro text during KIDS Install.
  1.  ;;If you run interactively, results will be displayed on your screen,
  1.  ;;and recorded in the entry in the INSTALL file.
  1.  ;;If you queue to TaskMan, remember not to Q to the HOME device.
  1.  ;;###
  1.  ;