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

ADE60P15.m

Go to the documentation of this file. 
  1. ADE60P15 ; IHS/SET/HMW - ADE6.0 PATCH 15 ;  
  1.  ;;6.0;ADE;**15**;JAN 01, 2004
  1.  ;
  1.  ; This patch accumulates ADE patches 1 through 15
  1.  ; I copied this from ADE60P14 and only change POST line tag
  1.  ;
  1. ENV ;Environment check
  1.  I '$G(IOM) D HOME^%ZIS
  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.  I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." D SORRY(2) Q
  1.  ;
  1.  S X=$$GET1^DIQ(200,DUZ,.01)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment...",IOM)
  1.  ;
  1.  NEW IORVON,IORVOFF
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  ;
  1.  I $$VCHK("ADE","6.0",2,"'=")
  1.  ;
  1.  NEW DA,DIC
  1.  S X="ADE",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","ADE")) D
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""ADE"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
  1.  . D SORRY(2)
  1.  .Q
  1.  ;
  1.  ;is the AUT requirement present?
  1.  I '$$ISAUT14 D
  1.  .D BMES^XPDUTL("Patch 15 of version 6.0 of the IHS DENTAL Package")
  1.  . D BMES^XPDUTL("Cannot Be Installed Unless")
  1.  . D BMES^XPDUTL("Patch 14 of version 98.1 of the AUT  IHS DICTIONARIES (POINTERS) package has been installed.")
  1.  . D SORRY(2)
  1.  Q
  1.  ;End Environment check
  1.  ;
  1. PREINST ;EP Pre-install -- Do previous patches as needed
  1.  ;
  1.  I '$$INSTALLD("ADE*6.0*15") D
  1.  .I '$$INSTALLD("ADE*6.0*14") D
  1.  . . I '$$INSTALLD("ADE*6.0*13") D
  1.  . . . I '$$INSTALLD("ADE*6.0*12") D
  1.  . . . . ;Install 12
  1.  . . . . D BMES^XPDUTL("Installing ADE Patch 12.")
  1.  . . . . D PREINST^ADE60P12
  1.  . . . . D ^ADECD4
  1.  . . . . Q
  1.  . . . ;Install 13
  1.  . . . D BMES^XPDUTL("Installing ADE Patch 13.")
  1.  . . . D ^ADECD44
  1.  . . . Q
  1.  . . ;DO I NEED A CALL HERE TO A PATCH 14 ROUTINE
  1.  . . ;Install 14
  1.  . .  D BMES^XPDUTL("Installing ADE Patch 14.")
  1.  . .  D POST^ADE60P14
  1.  . .  Q
  1.  Q
  1.  ;End Pre-Install
  1.  ;
  1. POST ;EP Post-Install
  1.  ; only post for patch 15 - LSL 12/12/03
  1.  ; Create 2 new entries in DENTAL PROGRAM OBJECTIVE File
  1.  N ADED,ADECNT,ADEVALUE
  1.  D BMES^XPDUTL("Creating RVU entries in DENTAL PROGRAM OBJECTIVE File...")
  1.  S ADED=";;"
  1.  S ADECNT=0
  1.  F  D ADDRVU Q:ADEVALUE="END"
  1.  D BMES^XPDUTL(" ...DONE")
  1.  ;
  1.  D BMES^XPDUTL("Populating new RVU field in the ADA Code File and updating Level of Service...")
  1.  D ^ADEADRVU
  1.  D BMES^XPDUTL("...DONE")
  1.  Q
  1.  ; ********************************************************************
  1. ADDRVU ;
  1.  S ADECNT=ADECNT+1
  1.  S ADEVALUE=$P($T(@1+ADECNT),ADED,2,7)
  1.  Q:ADEVALUE="END"
  1.  K DIC,DA,X,Y
  1.  S DIC="^ADEKOB("
  1.  S DIC(0)="LZE"
  1.  S DINUM=$P(ADEVALUE,ADED)
  1.  S X=$P(ADEVALUE,ADED,2)
  1.  S DIC("DR")=".02///^S X=$P(ADEVALUE,ADED,3)"
  1.  S DIC("DR")=DIC("DR")_";.03///^S X=$P(ADEVALUE,ADED,4)"
  1.  S DIC("DR")=DIC("DR")_";.11///^S X=$P(ADEVALUE,ADED,5)"
  1.  S DIC("DR")=DIC("DR")_";.22///^S X=$P(ADEVALUE,ADED,6)"
  1.  K DD,DO
  1.  D FILE^DICN
  1.  Q
  1.  ; End - LSL 12/12/03
  1.  ;
  1. VCHK(ADEPRE,ADEVER,ADEQUIT,ADECOMP) ; Check versions needed.
  1.  ;  
  1.  NEW ADEV
  1.  S ADEV=$$VERSION^XPDUTL(ADEPRE)
  1.  W !,$$CJ^XLFSTR("Need "_$S(ADECOMP="<":"at least ",1:"")_ADEPRE_" v "_ADEVER_"....."_ADEPRE_" v "_ADEV_" Present",IOM)
  1.  I @($C(34)_ADEV_$C(34)_ADECOMP_$C(34)_ADEVER_$C(34)) D SORRY(ADEQUIT) Q 0
  1.  Q 1
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",IOM)
  1.  Q
  1.  ;Determine if AUT*98.1*14 is present. This patch adds the RVU (Relative Value Unit) field to the ADA Code
  1. ISAUT14() ;
  1.  S KFINISH=$O(^XPD(9.7,"B","AUT*98.1*14",""))
  1.  I $G(KFINISH)="" Q 0
  1.  S KSTATUS=$P($G(^XPD(9.7,KFINISH,0)),U,9)  ;'0' Loaded from Distribution
  1.  ;                                           '1' Queued for Install 
  1.  ;                                           '2' Start of Install 
  1.  ;                                           '3' Install Completed 
  1.  ;                                           '4' FOR De-Installed; 
  1.  ;
  1.  I KSTATUS'=3 Q 0
  1.  Q 1
  1.  ;
  1. INSTALLD(ADE) ; Determine if patch ADE was installed, where ADE is
  1.  ; the name of the INSTALL.  E.g "AVA*93.2*12".
  1.  ;
  1.  NEW DIC,X,Y
  1.  ;  lookup package.
  1.  S X=$P(ADE,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 Q 0
  1.  ;  lookup version.
  1.  S DIC=DIC_+Y_",22,",X=$P(ADE,"*",2)
  1.  D ^DIC
  1.  I Y<1 Q 0
  1.  ;  lookup patch.
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(ADE,"*",3)
  1.  D ^DIC
  1.  Q $S(Y<1:0,1:1)
  1.  ; *********************************************************************
  1.  ; IEN;;OBJECTIVE;;MONITORING AGES;;COUNT AGES;;LOGIC;;LEVEL
  1.  ; *********************************************************************
  1. 1 ;;
  1.  ;;33;;RVU (INDIAN);;5:19;20:34;35:44;;0:4;5:9;10:14;15:19;20:34;35:44;45:54;55:64;65:125;;D SVC;ADEKNT2(1,2);;PATIENT
  1.  ;;34;;RVU (NON-INDIAN);;5:19;20:34;35:44;;0:4;5:9;10:14;15:19;20:34;35:44;45:54;55:64;65:125;;D SVC;ADEKNT2(2,2);;PATIENT
  1.  ;;END