- ADE60P26 ;IHS/OIT/GAB - ADE6.0 PATCH 26 [ 10/17/2014 2:35 PM ]
- ;;6.0;ADE*6.0*26;;March 25, 1999;Build 13
- ;;This patch contains calls to 3 ADE PATCH 26 routines with
- ;;2015 Dental Code Updates
- ENV ;Environment check
- I '$G(IOM) D HOME^%ZIS
- ;
- I '$G(DUZ) W !,"YOUR DUZ VARIABLE IS UNDEFINED!! Please login with your Access & Verify." D SORRY(2) Q
- ;
- I '$L($G(DUZ(0))) W !,"Your DUZ(0) VARIABLE IS UNDEFINED OR NULL." D SORRY(2) Q
- ;
- I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"YOUR DUZ(0) VARIABLE DOES NOT CONTAIN AN '@'." D SORRY(2)
- Q
- POST ;EP Post-Install
- ; only post for patch 26 - /IHS/OIT/GAB 10/30/14
- ; Add new, modify and delete ADA Codes
- N ADED,ADECNT,ADEVALUE
- D BMES^XPDUTL("Adding 2015 ADA-CDT Codes...")
- D ADDCDT5^ADE6P261
- D BMES^XPDUTL(" ...DONE")
- D BMES^XPDUTL("2015 Mods to Dental Codes...")
- D MODCDT5^ADE6P262
- D BMES^XPDUTL(" ...DONE")
- D BMES^XPDUTL("2015 Mods to Dental Codes ...")
- D DELCDT5^ADE6P263
- D BMES^XPDUTL("...DONE")
- ;IHS/OIT/GAB 12.2014 ADDED BELOW SECTION TO ADD DENTAL OBJECTIVE 9986 (BROKEN APPT)
- D BMES^XPDUTL("Creating new entry in DENTAL PROGRAM OBJECTIVE File...")
- S ADED=";;"
- S ADECNT=0
- F D ADDRVU Q:ADEVALUE="END"
- D BMES^XPDUTL(" ...DONE")
- Q
- ; ********************************************************************
- ADDRVU ;
- S ADECNT=ADECNT+1
- S ADEVALUE=$P($T(@1+ADECNT),ADED,2,7)
- Q:ADEVALUE="END"
- K DIC,DA,X,Y
- S DIC="^ADEKOB("
- S DIC(0)="LZE"
- S DINUM=$P(ADEVALUE,ADED)
- S X=$P(ADEVALUE,ADED,2)
- S DIC("DR")=".02///^S X=$P(ADEVALUE,ADED,3)"
- S DIC("DR")=DIC("DR")_";.03///^S X=$P(ADEVALUE,ADED,4)"
- S DIC("DR")=DIC("DR")_";.11///^S X=$P(ADEVALUE,ADED,5)"
- S DIC("DR")=DIC("DR")_";.22///^S X=$P(ADEVALUE,ADED,6)"
- K DD,DO
- D FILE^DICN
- Q
- ;
- SORRY(X) ;
- K DIFQ
- S XPDQUIT=X
- W *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",40)
- Q
- ; *********************************************************************
- ; IEN;;OBJECTIVE;;MONITORING AGES;;COUNT AGES;;LOGIC;;LEVEL
- ; *********************************************************************
- 1 ;;
- ;;35;;9986 - BA (ALL);;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 TOTAL;ADEKNT2(9986,0);;PATIENT
- ;;END
- ADE60P26 ;IHS/OIT/GAB - ADE6.0 PATCH 26 [ 10/17/2014 2:35 PM ]
- +1 ;;6.0;ADE*6.0*26;;March 25, 1999;Build 13
- +2 ;;This patch contains calls to 3 ADE PATCH 26 routines with
- +3 ;;2015 Dental Code Updates
- ENV ;Environment check
- +1 IF '$GET(IOM)
- DO HOME^%ZIS
- +2 ;
- +3 IF '$GET(DUZ)
- WRITE !,"YOUR DUZ VARIABLE IS UNDEFINED!! Please login with your Access & Verify."
- DO SORRY(2)
- QUIT
- +4 ;
- +5 IF '$LENGTH($GET(DUZ(0)))
- WRITE !,"Your DUZ(0) VARIABLE IS UNDEFINED OR NULL."
- DO SORRY(2)
- QUIT
- +6 ;
- +7 IF '(DUZ(0)["@")
- IF '$DATA(ZTQUEUED)
- WRITE !,"YOUR DUZ(0) VARIABLE DOES NOT CONTAIN AN '@'."
- DO SORRY(2)
- +8 QUIT
- POST ;EP Post-Install
- +1 ; only post for patch 26 - /IHS/OIT/GAB 10/30/14
- +2 ; Add new, modify and delete ADA Codes
- +3 NEW ADED,ADECNT,ADEVALUE
- +4 DO BMES^XPDUTL("Adding 2015 ADA-CDT Codes...")
- +5 DO ADDCDT5^ADE6P261
- +6 DO BMES^XPDUTL(" ...DONE")
- +7 DO BMES^XPDUTL("2015 Mods to Dental Codes...")
- +8 DO MODCDT5^ADE6P262
- +9 DO BMES^XPDUTL(" ...DONE")
- +10 DO BMES^XPDUTL("2015 Mods to Dental Codes ...")
- +11 DO DELCDT5^ADE6P263
- +12 DO BMES^XPDUTL("...DONE")
- +13 ;IHS/OIT/GAB 12.2014 ADDED BELOW SECTION TO ADD DENTAL OBJECTIVE 9986 (BROKEN APPT)
- +14 DO BMES^XPDUTL("Creating new entry in DENTAL PROGRAM OBJECTIVE File...")
- +15 SET ADED=";;"
- +16 SET ADECNT=0
- +17 FOR
- DO ADDRVU
- IF ADEVALUE="END"
- QUIT
- +18 DO BMES^XPDUTL(" ...DONE")
- +19 QUIT
- +20 ; ********************************************************************
- ADDRVU ;
- +1 SET ADECNT=ADECNT+1
- +2 SET ADEVALUE=$PIECE($TEXT(@1+ADECNT),ADED,2,7)
- +3 IF ADEVALUE="END"
- QUIT
- +4 KILL DIC,DA,X,Y
- +5 SET DIC="^ADEKOB("
- +6 SET DIC(0)="LZE"
- +7 SET DINUM=$PIECE(ADEVALUE,ADED)
- +8 SET X=$PIECE(ADEVALUE,ADED,2)
- +9 SET DIC("DR")=".02///^S X=$P(ADEVALUE,ADED,3)"
- +10 SET DIC("DR")=DIC("DR")_";.03///^S X=$P(ADEVALUE,ADED,4)"
- +11 SET DIC("DR")=DIC("DR")_";.11///^S X=$P(ADEVALUE,ADED,5)"
- +12 SET DIC("DR")=DIC("DR")_";.22///^S X=$P(ADEVALUE,ADED,6)"
- +13 KILL DD,DO
- +14 DO FILE^DICN
- +15 QUIT
- +16 ;
- SORRY(X) ;
- +1 KILL DIFQ
- +2 SET XPDQUIT=X
- +3 WRITE *7,!,$$CJ^XLFSTR("Sorry....Please fix it.",40)
- +4 QUIT
- +5 ; *********************************************************************
- +6 ; IEN;;OBJECTIVE;;MONITORING AGES;;COUNT AGES;;LOGIC;;LEVEL
- +7 ; *********************************************************************
- 1 ;;
- +1 ;;35;;9986 - BA (ALL);;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 TOTAL;ADEKNT2(9986,0);;PATIENT
- +2 ;;END
