- ADE60P16 ; IHS/SET/HMW - ADE GENERAL PATCH MODULE ; [ 07/28/2005 10:58 AM ]
- ;;6.0;ADE;**16**;JAN 01, 2004
- ;
- ; This patch accumulates ADE patches 1 through 16
- ; I copied this from ADE60P15 and only change POST line tag
- ;
- ENV ;Environment check
- I '$G(IOM) D HOME^%ZIS
- ;
- 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
- ;
- I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." D SORRY(2) Q
- ;
- S X=$$GET1^DIQ(200,DUZ,.01)
- W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
- W !!,$$CJ^XLFSTR("Checking Environment...",IOM)
- ;
- NEW IORVON,IORVOFF
- S X="IORVON;IORVOFF"
- D ENDR^%ZISS
- ;
- I $$VCHK("ADE","6.0",2,"'=")
- ;
- NEW DA,DIC
- S X="ADE",DIC="^DIC(9.4,",DIC(0)="",D="C"
- D IX^DIC
- I Y<0,$D(^DIC(9.4,"C","ADE")) D
- . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""ADE"" prefix.",IOM)
- . W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
- . D SORRY(2)
- .Q
- ;
- ;is the AUT requirement present?
- I '$$ISAUT14 D
- .D BMES^XPDUTL("Patch 16 of version 6.0 of the IHS DENTAL Package")
- . D BMES^XPDUTL("Cannot Be Installed Unless")
- . D BMES^XPDUTL("Patch 14 of version 98.1 of the AUT IHS DICTIONARIES (POINTERS) package has been installed.")
- . D SORRY(2)
- Q
- ;End Environment check
- ;
- PREINST ;EP Pre-install -- Do previous patches as needed
- ;
- I '$$INSTALLD("ADE*6.0*16") D
- .I '$$INSTALLD("ADE*6.0*15") D
- . . I '$$INSTALLD("ADE*6.0*14") D
- . . . I '$$INSTALLD("ADE*6.0*13") D
- . . . . I '$$INSTALLD("ADE*6.0*12") D
- . . . . . ;Install 12
- . . . . . D BMES^XPDUTL("Installing ADE Patch 12.")
- . . . . . D PREINST^ADE60P12
- . . . . . D ^ADECD4
- . . . . . Q
- . . . . ;Install 13
- . . . . D BMES^XPDUTL("Installing ADE Patch 13.")
- . . . . D ^ADECD44
- . . . . Q
- . . . ;DO I NEED A CALL HERE TO A PATCH 14 ROUTINE
- . . . ;Install 14
- . . . D BMES^XPDUTL("Installing ADE Patch 14.")
- . . . D POST^ADE60P14
- . . . Q
- . . ;Install 15
- . . D BMES^XPDUTL("Installing ADE Patch 15.")
- . . D POST^ADE60P15
- . . Q
- . Q
- Q
- ;End Pre-Install
- ;
- POST ;EP Post-Install
- ; only post for patch 16 - MJL 7/7/05
- ; Add new, modify and delete ADA Codes
- N ADED,ADECNT,ADEVALUE
- D BMES^XPDUTL("Adding ADA Codes: CDT-5 New Codes...")
- D ADDCDT5^ADE6P161
- D BMES^XPDUTL(" ...DONE")
- D BMES^XPDUTL("Mods to ADA Codes: CDT-5 Codes/Categories with New Descriptors...")
- D MODCDT5^ADE6P162
- D BMES^XPDUTL(" ...DONE")
- D BMES^XPDUTL("Deleting ADA Codes: Codes Deleted in CDT-5...")
- D DELCDT5^ADE6P163
- D BMES^XPDUTL("...DONE")
- D BMES^XPDUTL("Mods to ADA Codes: Existing CDT-4 Codes with Revised RVUs...")
- D MODCDT4^ADE6P164
- D BMES^XPDUTL("...DONE")
- Q
- ; ********************************************************************
- ;
- VCHK(ADEPRE,ADEVER,ADEQUIT,ADECOMP) ; Check versions needed.
- ;
- NEW ADEV
- S ADEV=$$VERSION^XPDUTL(ADEPRE)
- W !,$$CJ^XLFSTR("Need "_$S(ADECOMP="<":"at least ",1:"")_ADEPRE_" v "_ADEVER_"....."_ADEPRE_" v "_ADEV_" Present",IOM)
- I @($C(34)_ADEV_$C(34)_ADECOMP_$C(34)_ADEVER_$C(34)) D SORRY(ADEQUIT) Q 0
- Q 1
- ;
- SORRY(X) ;
- KILL DIFQ
- S XPDQUIT=X
- W *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",IOM)
- Q
- ;Determine if AUT*98.1*14 is present. This patch adds the RVU (Relative Value Unit) field to the ADA Code
- ISAUT14() ;
- S KFINISH=$O(^XPD(9.7,"B","AUT*98.1*14",""))
- I $G(KFINISH)="" Q 0
- S KSTATUS=$P($G(^XPD(9.7,KFINISH,0)),U,9) ;'0' Loaded from Distribution
- ; '1' Queued for Install
- ; '2' Start of Install
- ; '3' Install Completed
- ; '4' FOR De-Installed;
- ;
- I KSTATUS'=3 Q 0
- Q 1
- ;
- INSTALLD(ADE) ; Determine if patch ADE was installed, where ADE is
- ; the name of the INSTALL. E.g "AVA*93.2*12".
- ;
- NEW DIC,X,Y
- ; lookup package.
- S X=$P(ADE,"*",1)
- S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
- D IX^DIC
- I Y<1 Q 0
- ; lookup version.
- S DIC=DIC_+Y_",22,",X=$P(ADE,"*",2)
- D ^DIC
- I Y<1 Q 0
- ; lookup patch.
- S DIC=DIC_+Y_",""PAH"",",X=$P(ADE,"*",3)
- D ^DIC
- Q $S(Y<1:0,1:1)
- ADE60P16 ; IHS/SET/HMW - ADE GENERAL PATCH MODULE ; [ 07/28/2005 10:58 AM ]
- +1 ;;6.0;ADE;**16**;JAN 01, 2004
- +2 ;
- +3 ; This patch accumulates ADE patches 1 through 16
- +4 ; I copied this from ADE60P15 and only change POST line tag
- +5 ;
- ENV ;Environment check
- +1 IF '$GET(IOM)
- DO HOME^%ZIS
- +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 IF '(DUZ(0)["@")
- IF '$DATA(ZTQUEUED)
- WRITE !,"DUZ(0) DOES NOT CONTAIN AN '@'."
- DO SORRY(2)
- QUIT
- +8 ;
- +9 SET X=$$GET1^DIQ(200,DUZ,.01)
- +10 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
- +11 WRITE !!,$$CJ^XLFSTR("Checking Environment...",IOM)
- +12 ;
- +13 NEW IORVON,IORVOFF
- +14 SET X="IORVON;IORVOFF"
- +15 DO ENDR^%ZISS
- +16 ;
- +17 IF $$VCHK("ADE","6.0",2,"'=")
- +18 ;
- +19 NEW DA,DIC
- +20 SET X="ADE"
- 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","ADE"))
- Begin DoDot:1
- +23 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""ADE"" prefix.",IOM)
- +24 WRITE !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
- +25 DO SORRY(2)
- +26 QUIT
- End DoDot:1
- +27 ;
- +28 ;is the AUT requirement present?
- +29 IF '$$ISAUT14
- Begin DoDot:1
- +30 DO BMES^XPDUTL("Patch 16 of version 6.0 of the IHS DENTAL Package")
- +31 DO BMES^XPDUTL("Cannot Be Installed Unless")
- +32 DO BMES^XPDUTL("Patch 14 of version 98.1 of the AUT IHS DICTIONARIES (POINTERS) package has been installed.")
- +33 DO SORRY(2)
- End DoDot:1
- +34 QUIT
- +35 ;End Environment check
- +36 ;
- PREINST ;EP Pre-install -- Do previous patches as needed
- +1 ;
- +2 IF '$$INSTALLD("ADE*6.0*16")
- Begin DoDot:1
- +3 IF '$$INSTALLD("ADE*6.0*15")
- Begin DoDot:2
- +4 IF '$$INSTALLD("ADE*6.0*14")
- Begin DoDot:3
- +5 IF '$$INSTALLD("ADE*6.0*13")
- Begin DoDot:4
- +6 IF '$$INSTALLD("ADE*6.0*12")
- Begin DoDot:5
- +7 ;Install 12
- +8 DO BMES^XPDUTL("Installing ADE Patch 12.")
- +9 DO PREINST^ADE60P12
- +10 DO ^ADECD4
- +11 QUIT
- End DoDot:5
- +12 ;Install 13
- +13 DO BMES^XPDUTL("Installing ADE Patch 13.")
- +14 DO ^ADECD44
- +15 QUIT
- End DoDot:4
- +16 ;DO I NEED A CALL HERE TO A PATCH 14 ROUTINE
- +17 ;Install 14
- +18 DO BMES^XPDUTL("Installing ADE Patch 14.")
- +19 DO POST^ADE60P14
- +20 QUIT
- End DoDot:3
- +21 ;Install 15
- +22 DO BMES^XPDUTL("Installing ADE Patch 15.")
- +23 DO POST^ADE60P15
- +24 QUIT
- End DoDot:2
- +25 QUIT
- End DoDot:1
- +26 QUIT
- +27 ;End Pre-Install
- +28 ;
- POST ;EP Post-Install
- +1 ; only post for patch 16 - MJL 7/7/05
- +2 ; Add new, modify and delete ADA Codes
- +3 NEW ADED,ADECNT,ADEVALUE
- +4 DO BMES^XPDUTL("Adding ADA Codes: CDT-5 New Codes...")
- +5 DO ADDCDT5^ADE6P161
- +6 DO BMES^XPDUTL(" ...DONE")
- +7 DO BMES^XPDUTL("Mods to ADA Codes: CDT-5 Codes/Categories with New Descriptors...")
- +8 DO MODCDT5^ADE6P162
- +9 DO BMES^XPDUTL(" ...DONE")
- +10 DO BMES^XPDUTL("Deleting ADA Codes: Codes Deleted in CDT-5...")
- +11 DO DELCDT5^ADE6P163
- +12 DO BMES^XPDUTL("...DONE")
- +13 DO BMES^XPDUTL("Mods to ADA Codes: Existing CDT-4 Codes with Revised RVUs...")
- +14 DO MODCDT4^ADE6P164
- +15 DO BMES^XPDUTL("...DONE")
- +16 QUIT
- +17 ; ********************************************************************
- +18 ;
- VCHK(ADEPRE,ADEVER,ADEQUIT,ADECOMP) ; Check versions needed.
- +1 ;
- +2 NEW ADEV
- +3 SET ADEV=$$VERSION^XPDUTL(ADEPRE)
- +4 WRITE !,$$CJ^XLFSTR("Need "_$SELECT(ADECOMP="<":"at least ",1:"")_ADEPRE_" v "_ADEVER_"....."_ADEPRE_" v "_ADEV_" Present",IOM)
- +5 IF @($CHAR(34)_ADEV_$CHAR(34)_ADECOMP_$CHAR(34)_ADEVER_$CHAR(34))
- DO SORRY(ADEQUIT)
- QUIT 0
- +6 QUIT 1
- +7 ;
- SORRY(X) ;
- +1 KILL DIFQ
- +2 SET XPDQUIT=X
- +3 WRITE *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",IOM)
- +4 QUIT
- +5 ;Determine if AUT*98.1*14 is present. This patch adds the RVU (Relative Value Unit) field to the ADA Code
- ISAUT14() ;
- +1 SET KFINISH=$ORDER(^XPD(9.7,"B","AUT*98.1*14",""))
- +2 IF $GET(KFINISH)=""
- QUIT 0
- +3 ;'0' Loaded from Distribution
- SET KSTATUS=$PIECE($GET(^XPD(9.7,KFINISH,0)),U,9)
- +4 ; '1' Queued for Install
- +5 ; '2' Start of Install
- +6 ; '3' Install Completed
- +7 ; '4' FOR De-Installed;
- +8 ;
- +9 IF KSTATUS'=3
- QUIT 0
- +10 QUIT 1
- +11 ;
- INSTALLD(ADE) ; Determine if patch ADE was installed, where ADE is
- +1 ; the name of the INSTALL. E.g "AVA*93.2*12".
- +2 ;
- +3 NEW DIC,X,Y
- +4 ; lookup package.
- +5 SET X=$PIECE(ADE,"*",1)
- +6 SET DIC="^DIC(9.4,"
- SET DIC(0)="FM"
- SET D="C"
- +7 DO IX^DIC
- +8 IF Y<1
- QUIT 0
- +9 ; lookup version.
- +10 SET DIC=DIC_+Y_",22,"
- SET X=$PIECE(ADE,"*",2)
- +11 DO ^DIC
- +12 IF Y<1
- QUIT 0
- +13 ; lookup patch.
- +14 SET DIC=DIC_+Y_",""PAH"","
- SET X=$PIECE(ADE,"*",3)
- +15 DO ^DIC
- +16 QUIT $SELECT(Y<1:0,1:1)
