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

ACPT219.m

Go to the documentation of this file. 
  1. ACPT219 ;IHS/OIT/NKD - ACPT V2.19 CPT ENVIRONMENT CHECKER 12/17/18 ;
  1.  ;;2.19;CPT FILES;;DEC 17, 2018;Build 1
  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.  N ACPTV,ACPTP
  1.  S ACPTV=$P($T(+2),";",3),ACPTP=$P($T(+2),";",5),ACPTP=$S($L(ACPTP)>4:$P(ACPTP,"**",2),1:""),ACPTP=$S(ACPTP]"":$P(ACPTP,",",$L(ACPTP,",")),1:"")
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_ACPTV_$S(ACPTP]"":" Patch "_ACPTP,1:"")_".",IOM),!
  1.  ;
  1.  S:'$$VCHK("XU","8.0") XPDQUIT=2
  1.  S:'$$VCHK("DI","22.0") XPDQUIT=2
  1.  S:'$$VCHK("XT","7.3") XPDQUIT=2
  1.  S:'$$VCHK("ACPT","2.18","2") XPDQUIT=2
  1.  S:'$$VCHK("BCSV","1.0","3") XPDQUIT=2
  1.  ;
  1.  S:'$$GCHK() XPDQUIT=2
  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.  ;
  1.  Q
  1. GCHK() ; Check transport global version
  1.  Q:'$D(XPDENV) 1
  1.  N ACPTG,ACPTV S ACPTG="ACPT GLOBAL"_$P($G(XPDNM),"ACPT",2),ACPTV=$G(^ACPT(0,"BUILD"))
  1.  I '$L(ACPTV) W !,$$CJ^XLFSTR("Transport global not installed or lacks version number! ***FIX IT***",IOM) Q 0
  1.  W !,$$CJ^XLFSTR("Need at least "_ACPTG_"....."_ACPTV_" Present"_$S(ACPTV'=ACPTG:" ***FIX IT***",1:""),IOM)
  1.  Q $S(ACPTV=ACPTG:1,1:0)
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;
  1. VCHK(ACPTPRE,ACPTVER,ACPTPAT) ; Check patch level
  1.  N ACPTV,ACPTP
  1.  S ACPTV=$$VERSION^XPDUTL(ACPTPRE)
  1.  I (ACPTV<ACPTVER) K DIFQ D DISP(ACPTPRE,ACPTVER,$G(ACPTPAT),ACPTV,$G(ACPTP),0) Q 0
  1.  I '$D(ACPTPAT) D DISP(ACPTPRE,ACPTVER,$G(ACPTPAT),ACPTV,$G(ACPTP),1) Q 1
  1.  S ACPTP=+$$LAST(ACPTPRE,ACPTVER)
  1.  I (ACPTP<ACPTPAT) K DIFQ D DISP(ACPTPRE,ACPTVER,$G(ACPTPAT),ACPTVER,$G(ACPTP),0) Q 0
  1.  D DISP(ACPTPRE,ACPTVER,$G(ACPTPAT),ACPTVER,$G(ACPTP),1)
  1.  Q 1
  1. DISP(ACPTPRE,ACPTVER,ACPTPAT,ACPTV,ACPTP,ACPTR) ; Display requirement checking results
  1.  ;
  1.  N ACPTS
  1.  S ACPTS="Need at least "_$G(ACPTPRE)_" v"_$G(ACPTVER)_$S($G(ACPTPAT)]"":" p"_$G(ACPTPAT),1:"")_"....."
  1.  S ACPTS=ACPTS_$G(ACPTPRE)_" v"_$G(ACPTV)_$S($G(ACPTP)]"":" p"_$G(ACPTP),1:"")_" Present"
  1.  S ACPTS=ACPTS_$S('ACPTR:" ***FIX IT***",1:"")
  1.  W !,$$CJ^XLFSTR(ACPTS,IOM)
  1.  Q
  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,"C",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. PRE ; EP - PRE-INSTALL
  1.  ; IF ANNUAL UPDATE, RUN PRE-INSTALL UTILITIES
  1.  I $L($P($T(+2),";",5))<5 D
  1.  . ;D REINDEX
  1.  . D CPTCINA
  1.  Q
  1.  ;
  1. POST ; EP - POST-INSTALL
  1.  ; CALCULATE DEFAULT EFFECTIVE DATE BASED ON VERSION/PATCH
  1.  N ACPTYR S ACPTYR=$P($T(+2),";",3)*1000000+1000101+(+$TR($P($T(+2),";",5),"*")*300)
  1.  ; RUN CPT/HCPCS/CAT UPDATE
  1.  D UPDATE^ACPTD
  1.  ; ANNUAL UPDATE REPORTS
  1.  I $L($P($T(+2),";",5))<5 D
  1.  . D RSLT^ACPTUTL($$REPEAT^XLFSTR("-",5)_" Annual consistency reports "_$$REPEAT^XLFSTR("-",5),1)
  1.  . D DRPT           ; DUPLICATES
  1.  . D ARPT("CPT")    ; ANNUAL CPT
  1.  . D ARPT("HCPCS")  ; ANNUAL HCPCS
  1.  ;
  1.  I $D(^ACPT("CAT")) D CATUPD^ACPTUTL  ; ASSIGN/UPDATE CPT CATEGORIES
  1.  K ^ACPT(0),^ACPT("CPT"),^ACPT("HCPCS"),^ACPT("CAT") ; DELETE TRANSPORT GLOBAL AFTER UPDATE
  1.  Q
  1.  ;
  1. REINDEX ; COMPLETE RE-INDEX OF FILES 81, 81.3, AND 81.1
  1.  N IND,DA,DIK
  1.  D RSLT^ACPTUTL($$REPEAT^XLFSTR("-",5)_" Reindexing CPT file (81)",1)
  1.  K DA,DIK
  1.  F IND="ACT","ADS","AST","B","BA","C","D","E","F","I" K ^ICPT(IND)
  1.  S DIK="^ICPT("
  1.  D IXALL^DIK
  1.  D RSLT^ACPTUTL($$REPEAT^XLFSTR("-",5)_" Reindexing CPT MODIFIER file (81.3)",1)
  1.  K DA,DIK
  1.  F IND="ACT","ADS","AST","B","BA","C","D","M" K ^DIC(81.3,IND)
  1.  S DIK="^DIC(81.3,"
  1.  D IXALL^DIK
  1.  D RSLT^ACPTUTL($$REPEAT^XLFSTR("-",5)_" Reindexing CPT CATEGORY file (81.1)",1)
  1.  K DA,DIK
  1.  F IND="ACPT","B","C","M","R" K ^DIC(81.1,IND)
  1.  S DIK="^DIC(81.1,"
  1.  D IXALL^DIK
  1.  Q
  1.  ;
  1. CPTCINA ; CORRECT IMPROPERLY INACTIVATED CPT CODES
  1.  ; Examines the CPT file and inactivates any code that has an Active Date (8) < Inactive Date (7) without an Inactive Flag (5)
  1.  D RSLT^ACPTUTL($$REPEAT^XLFSTR("-",5)_" Fixing improperly inactivated CPT codes",1)
  1.  N ACPTC,ACPTI,ACPTCNT,FDA
  1.  S (ACPTC,ACPTCNT)=0 F  S ACPTC=$O(^ICPT("BA",ACPTC)) Q:ACPTC']""  D
  1.  . Q:ACPTC="00099 "
  1.  . S ACPTI=0 F  S ACPTI=$O(^ICPT("BA",ACPTC,ACPTI)) Q:ACPTI']""  D
  1.  . . Q:'$D(^ICPT(ACPTI,0))
  1.  . . Q:$P(^ICPT(ACPTI,0),U,4)=1
  1.  . . Q:$P(^ICPT(ACPTI,0),U,7)']""
  1.  . . Q:+$P(^ICPT(ACPTI,0),U,8)>+$P(^ICPT(ACPTI,0),U,7)
  1.  . . K FDA
  1.  . . S FDA(81,ACPTI_",",5)="1" ; Inactive Flag (5)
  1.  . . D UPDATE^DIE(,"FDA",)
  1.  . . S ACPTCNT=ACPTCNT+1
  1.  . . I '(ACPTCNT#1000) W "."
  1.  Q
  1.  ;
  1. DRPT ; DUPLICATE REPORT - DISPLAY ACTIVE DUPLICATE CODES
  1.  N ACPTC,ACPTI,ACPTR
  1.  D RSLT^ACPTUTL($$REPEAT^XLFSTR("-",5)_" Duplicate Report: Active duplicate CPT/HCPCS codes",1)
  1.  S ACPTC=0 F  S ACPTC=$O(^ICPT("BA",ACPTC)) Q:ACPTC']""  D
  1.  . S ACPTI=0,ACPTR="" F  S ACPTI=$O(^ICPT("BA",ACPTC,ACPTI)) Q:ACPTI']""  D
  1.  . . Q:'$D(^ICPT(ACPTI,0))  Q:$P(^ICPT(ACPTI,0),U,4)=1
  1.  . . S ACPTR=ACPTR_ACPTI_U
  1.  . S:$E(ACPTR,$L(ACPTR))=U ACPTR=$E(ACPTR,1,$L(ACPTR)-1)
  1.  . I $L(ACPTR,U)>1 D RSLT^ACPTUTL("CODE: "_ACPTC_$J("",4)_"IENS: "_ACPTR)
  1.  Q
  1.  ;
  1. ARPT(ACPTT)  ; ANNUAL REPORT - ACTIVE LOCAL ENTRIES MISSING FROM ANNUAL CODE SET
  1.  N ACPTC,ACPTI,ACPTR S ACPTT=$G(ACPTT),ACPTR="" Q:'$L(ACPTT)  Q:'$D(^ACPT(ACPTT))
  1.  D RSLT^ACPTUTL($$REPEAT^XLFSTR("-",5)_" "_ACPTT_" Report: Active "_ACPTT_" entries not found in annual code set",1)
  1.  S ACPTC=0 F  S ACPTC=$O(^ICPT("BA",ACPTC)) Q:ACPTC']""  D
  1.  . Q:$D(^ACPT(ACPTT,"BA",ACPTC))  Q:$E(ACPTC)="D"
  1.  . S ACPTI=0 F  S ACPTI=$O(^ICPT("BA",ACPTC,ACPTI)) Q:'ACPTI  D
  1.  . . Q:'$D(^ICPT(ACPTI,0))  Q:$P(^ICPT(ACPTI,0),U,4)=1  Q:$P(^ICPT(ACPTI,0),U,6)'=$E(ACPTT)
  1.  . . S ACPTR=ACPTR_ACPTC_$J("",2)
  1.  . . I $L(ACPTR)>79 D RSLT^ACPTUTL(ACPTR) S ACPTR=""
  1.  I $L(ACPTR)>0 D RSLT^ACPTUTL(ACPTR)
  1.  Q