ADE60P26.m

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