ADE0608.m

ADE0608 ;IHS/HQT/MJL - DENTAL CODE EDIT GROUP FILE CORRECTIONS [ 06/19/2001  2:59 PM ]

 ;;6.0;ADE;**8**;JUL 1, 2001

CTL ;

 ; Find all "[EXTRACTION" edits and update, changing nothing, in order to fire cross-references that

 ; use the updated string of ADA codes defined in the "EXTRACTIONS" DENTAL CODE EDIT GROUP.  This is

 ; convoluted because the cross-reference logic should have been defined in the file definition of the

 ; DENTAL CODE EDIT GROUP, not where it currently is, in the file definition for DENTAL EDIT.

 ;

 ; Save the DENTAL CODE EDIT entries in ADEDIT

 S ADEFILE=9002007.9

 D FIND^DIC(ADEFILE,"",".01;1;1.3;1.4;2;2.4;3;4;4.1;5;6","X","[EXTRACTIONS","","","","","ADEDIT","ADEEMSG")

 I $D(ADEEMSG) D KILL Q

 ; Remove the current DENTAL CODE EDIT entries

 S DIK="^ADEDIT(" F ADEN=1:1:+ADEDIT("DILIST",0) S DA=ADEDIT("DILIST",2,ADEN) D ^DIK

 ; Change the EDIT GROUPS

 D EDITGRP

 ; Reset the DENTAL CODE EDIT entries

 S ADEFILE=9002007.9,ADEIENST="+1,",ADEUPDF="E",ADEWPFLD=1101,ADETXT=0

 F ADEN=1:1:+ADEDIT("DILIST",0) S ADEIEN(1)=ADEDIT("DILIST",2,ADEN) D EDIT

 D KILL

 Q

 ;

EDITGRP ;

 ;MOVE 3221,9971,9973,9974 FROM EXTRACTIONS TO ADEPHY-3

 S ADEFILE=9002007.91,ADEIENST="?+1,",ADEUPDF="",ADEWPFLD=1101,ADETXT=0

 S ADEFDA(ADEFILE,ADEIENST,.01)="EXTRACTIONS"

 S ADEFDA(ADEFILE,ADEIENST,1)="7110|7120|7111|7113|7112|7114|7210|7220|7230|7240|7241|7250"

 D FILE

 S ADEFDA(ADEFILE,ADEIENST,.01)="ADEPHY-3" ; There's no "[ADEPHY-3" DENTAL EDIT CODE entry

 S ADEFDA(ADEFILE,ADEIENST,1)="3110|3120|3220|3230|3240|3960|3221|9971|9973|9974"

 D FILE

 ; REMOVE GROUP "ADEPHY-7", its only member is 9930, which is no longer required

 S DIK="^ADEDIT(""GRP"",",DA=0 F  S DA=$O(^ADEDIT("GRP","B","ADEPHY-7",DA)) Q:'DA  D ^DIK

 Q

 ;

EDIT ;

 M ADEFDA(ADEFILE,ADEIENST)=ADEDIT("DILIST","ID",ADEN)

 D FILE

 Q

 ;

FILE ;

 D UPDATE^DIE(ADEUPDF,"ADEFDA","ADEIEN","ADEEMSG")

 K ADEFDA,ADEEMSG

 I '$D(ADEIEN(1)) S ADEERR=1 Q

 ; get the IEN assigned

 I ADETXT,ADETXT>1!(ADETEXT(1)'="") D WP^DIE(ADEFILE,ADEIEN(1)_",",ADEWPFLD,,"ADETEXT","ADEEMSG")

 K ADEEMSG,ADEFDA,ADEIEN,ADETEXT

 Q

 ;

KILL ;

 K ADEADA,ADECNT,ADECODE,ADEDESC,ADEDONE,ADEDIT,ADEEMSG,ADEFDA,ADEFILE,ADEICD9,ADEID,ADEIENST,ADELEV,ADEMIN,ADEMNE,ADEN,ADERLN,ADERN,ADERTN,ADESYN,ADETDT,ADETEXT,ADETXT,ADEUPDF,ADEUSE,ADEWPFLD,DA,DIC,DIE,DR,X

 Q

ADE0608   ;IHS/HQT/MJL - DENTAL CODE EDIT GROUP FILE CORRECTIONS [ 06/19/2001  2:59 PM ]

 +1       ;;6.0;ADE;**8**;JUL 1, 2001

CTL       ;

 +1       ; Find all "[EXTRACTION" edits and update, changing nothing, in order to fire cross-references that

 +2       ; use the updated string of ADA codes defined in the "EXTRACTIONS" DENTAL CODE EDIT GROUP.  This is

 +3       ; convoluted because the cross-reference logic should have been defined in the file definition of the

 +4       ; DENTAL CODE EDIT GROUP, not where it currently is, in the file definition for DENTAL EDIT.

 +5       ;

 +6       ; Save the DENTAL CODE EDIT entries in ADEDIT

 +7        SET ADEFILE=9002007.9

 +8        DO FIND^DIC(ADEFILE,"",".01;1;1.3;1.4;2;2.4;3;4;4.1;5;6","X","[EXTRACTIONS","","","","","ADEDIT","ADEEMSG")

 +9        IF $DATA(ADEEMSG)

               DO KILL

               QUIT 

 +10      ; Remove the current DENTAL CODE EDIT entries

 +11       SET DIK="^ADEDIT("

           FOR ADEN=1:1:+ADEDIT("DILIST",0)

               SET DA=ADEDIT("DILIST",2,ADEN)

               DO ^DIK

 +12      ; Change the EDIT GROUPS

 +13       DO EDITGRP

 +14      ; Reset the DENTAL CODE EDIT entries

 +15       SET ADEFILE=9002007.9

           SET ADEIENST="+1,"

           SET ADEUPDF="E"

           SET ADEWPFLD=1101

           SET ADETXT=0

 +16       FOR ADEN=1:1:+ADEDIT("DILIST",0)

               SET ADEIEN(1)=ADEDIT("DILIST",2,ADEN)

               DO EDIT

 +17       DO KILL

 +18       QUIT 

 +19      ;

EDITGRP   ;

 +1       ;MOVE 3221,9971,9973,9974 FROM EXTRACTIONS TO ADEPHY-3

 +2        SET ADEFILE=9002007.91

           SET ADEIENST="?+1,"

           SET ADEUPDF=""

           SET ADEWPFLD=1101

           SET ADETXT=0

 +3        SET ADEFDA(ADEFILE,ADEIENST,.01)="EXTRACTIONS"

 +4        SET ADEFDA(ADEFILE,ADEIENST,1)="7110|7120|7111|7113|7112|7114|7210|7220|7230|7240|7241|7250"

 +5        DO FILE

 +6       ; There's no "[ADEPHY-3" DENTAL EDIT CODE entry

           SET ADEFDA(ADEFILE,ADEIENST,.01)="ADEPHY-3"

 +7        SET ADEFDA(ADEFILE,ADEIENST,1)="3110|3120|3220|3230|3240|3960|3221|9971|9973|9974"

 +8        DO FILE

 +9       ; REMOVE GROUP "ADEPHY-7", its only member is 9930, which is no longer required

 +10       SET DIK="^ADEDIT(""GRP"","

           SET DA=0

           FOR 

               SET DA=$ORDER(^ADEDIT("GRP","B","ADEPHY-7",DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +11       QUIT 

 +12      ;

EDIT      ;

 +1        MERGE ADEFDA(ADEFILE,ADEIENST)=ADEDIT("DILIST","ID",ADEN)

 +2        DO FILE

 +3        QUIT 

 +4       ;

FILE      ;

 +1        DO UPDATE^DIE(ADEUPDF,"ADEFDA","ADEIEN","ADEEMSG")

 +2        KILL ADEFDA,ADEEMSG

 +3        IF '$DATA(ADEIEN(1))

               SET ADEERR=1

               QUIT 

 +4       ; get the IEN assigned

 +5        IF ADETXT

               IF ADETXT>1!(ADETEXT(1)'="")

                   DO WP^DIE(ADEFILE,ADEIEN(1)_",",ADEWPFLD,,"ADETEXT","ADEEMSG")

 +6        KILL ADEEMSG,ADEFDA,ADEIEN,ADETEXT

 +7        QUIT 

 +8       ;

KILL      ;

 +1        KILL ADEADA,ADECNT,ADECODE,ADEDESC,ADEDONE,ADEDIT,ADEEMSG,ADEFDA,ADEFILE,ADEICD9,ADEID,ADEIENST,ADELEV,ADEMIN,ADEMNE,ADEN,ADERLN,ADERN,ADERTN,ADESYN,ADETDT,ADETEXT,ADETXT,ADEUPDF,ADEUSE,ADEWPFLD,DA,DIC,DIE,DR,X

 +2        QUIT