AUMUPD4.m

AUMUPD4 ;IHS/OIT/NKD - SCB UPDATE  05/23/2012 ;

 ;;12.0;TABLE MAINTENANCE;**3**;SEP 27,2011;Build 1

 ;

ADDOK ;----- "ADDED" MESSAGE

 D RSLT($J("",5)_"ADDED       : "_L)

 Q

 ;

ADDFAIL ;----- "FAILED" MESSAGE

 D RSLT($J("",5)_$$M(0)_"ADD FAILED => "_L)

 Q

 ;

DASH ;----- PRT DASH LINE

 D RSLT("")

 D RSLT($$REPEAT^XLFSTR("-",$S($G(IOM):IOM-10,1:70)))

 D RSLT("")

 Q

 ;

DIE ;----- DIE EDIT

 N @($P($T(SVARS),";",3))

 L +(@(DIE_DA_")")):10

 E  D RSLT($J("",5)_$$M(0)_"Entry '"_DIE_DA_"' IS LOCKED.  NOTIFY PROGRAMMER.") S Y=1 Q

 D ^DIE

 L -(@(DIE_DA_")"))

 Q

 ;

DIK ;--- KILL ENTRY

 N @($P($T(SVARS),";",3)),DIK

 D ^DIK

 Q

 ;

FILE ;--- FILE NEW ENTRY

 N @($P($T(SVARS),";",3))

 K DD,DO

 S DIC(0)="L"

 D FILE^DICN

 K DIC,DLAYGO

 Q

 ;

M(%) ;--- ERROR MESSAGE

 Q $S(%=0:"ERROR : ",%=1:"NOT ADDED : ",1:"")

 ;

MODOK ;--- IF MOD OK 

 D RSLT($J("",5)_"CHANGED     : "_L)

 Q

 ;

INAOK ;--- IF INACTIVATE OK 

 D RSLT($J("",5)_"INACTIVATED : "_L)

 Q

 ;

DINAOK ;--- IF DUPLICATE INACTIVATE OK 

 D RSLT($J("",2)_"LOCAL DUPLICATE INACTIVATED : "_L)

 Q

 ;

RSLT(%) ;--- ISSUE MESSAGES DURING INSTALL

 N @($P($T(SVARS),";",3))

 D MES^XPDUTL(%)

 Q

 ;

IXDIC(DIC,DIC0,D,X,DLAYGO)   ;

 ;--- CALL TO FILEMAN IX^DIC

 N @($P($T(SVARS),";",3))

 S DIC(0)=DIC0

 K DIC0

 I '$G(DLAYGO) K DLAYGO

 D IX^DIC

 Q Y

 ;

PCLASALL ;EP --- PROVIDER TABLE UPDATE

 N C,CI,A,S,I,II,L,N,NI,AUMI,AUMII

 S C=$O(^DIC(7,"D","")),A="" ;TRAVERSE THE D INDEX (CODE)

 F  Q:$L(C)<1  D

 .S I=$O(^DIC(7,"D",C,"")) ;STORE THE IEN

 .;ITERATE THROUGH MASTER RETRIEVING CODES

 .F  Q:$L(I)<1  D

 ..N S

 ..;IF THE LOCAL CODE MATCHES, UPDATE THE LOCAL ENTRY AND REMOVE FROM THE MASTER

 ..F AUMII=1:1:$P(AUMPRV(0),"^",4) I $D(AUMPRV(AUMII,0)) S CI=$P(AUMPRV(AUMII,0),"^",1) Q:$D(S)  D

 ...I CI=C D RSLT("SERVICES RENDERED BY (PROVIDER) CODE CHANGES"),PCLASDIE S S="" K AUMPRV(AUMII,0)

 ..I '$D(S) S A=A_I_"^" ;IF NOT FOUND IN THE MASTER, STORE IEN IN LOCAL VARIABLE

 ..S I=$O(^DIC(7,"D",C,I)) ;ITERATE TO THE NEXT IEN WITH THIS CODE

 .S C=$O(^DIC(7,"D",C)) ;TRAVERSE TO THE NEXT CODE

 ;ITERATE THROUGH THE STORED IENs

 F AUMI=1:1 S I=$P(A,"^",AUMI) Q:$L(I)<1  D

 .N S

 .S N=$P(^DIC(7,I,0),"^",1) ;STORE THE NAME

 .;ITERATE THROUGH MASTER RETRIEVING NAMES

 .F AUMII=1:1:$P(AUMPRV(0),"^",4) I $D(AUMPRV(AUMII,0)) S NI=$P(AUMPRV(AUMII,0),"^",2) Q:$D(S)  D

 ..;IF THE LOCAL NAME MATCHES, UPDATE THE LOCAL ENTRY AND REMOVE FROM THE MASTER

 ..I NI=N D RSLT("SERVICES RENDERED BY (PROVIDER) NAME CHANGES"),PCLASDIE S S="" K AUMPRV(AUMII,0)

 .;IF NOT FOUND, INACTIVATE LOCAL ENTRY

 .I '$D(S)  D

 ..D RSLT("SERVICES RENDERED BY (PROVIDER) INACTIVATE")

 ..S L=$P(^DIC(7,I,9999999),"^",1)_" "_N_" "_$P(^DIC(7,I,9999999),"^",2)

 ..S DIE="^DIC(7,",DA=I,DR="9999999.06///"_DT D ^DIE

 ..I $D(Y) D RSLT($J("",5)_$$M(0)_"INACTIVATE PROVIDER CODE FAILED => "_L) Q

 ..D RSLT($J("",5)_"INACTIVATED : "_L)

 ;ITERATE THROUGH REMAINING MASTER ENTRIES AND ADD

 F AUMI=1:1:$P(AUMPRV(0),"^",4) I $D(AUMPRV(AUMI,0))  D

 .D RSLT("SERVICES RENDERED BY (PROVIDER) ADD")

 .S C=$P(AUMPRV(AUMI,0),"^",1),N=$P(AUMPRV(AUMI,0),"^",2),A=$P(AUMPRV(AUMI,0),"^",3),P=$P(AUMPRV(AUMI,0),"^",4),R=$P(AUMPRV(AUMI,0),"^",5)

 .S L=C_" "_N_$J("",(32-$L(N)))_A

 .I $D(^DIC(7,"D",C)) D RSLT($J("",5)_$$M(1)_"PROVIDER CODE EXISTS => "_C),RSLT("") Q

 .S DLAYGO=7,DIC="^DIC(7,",X=N,DIC("DR")="1///"_A_";9999999.01///"_C_";9999999.03///"_P_";9999999.05///"_R

 .D FILE

 .D @$S(Y>0:"ADDOK",1:"ADDFAIL")

 .K AUMPRV(AUMI,0)

 Q

PCLASDIE ;

 N C,N,A,P,R,L,DIE,DA,DR

 S C=$P(AUMPRV(AUMII,0),"^",1),N=$P(AUMPRV(AUMII,0),"^",2),A=$P(AUMPRV(AUMII,0),"^",3),P=$P(AUMPRV(AUMII,0),"^",4),R=$P(AUMPRV(AUMII,0),"^",5)

 S L=C_" "_N_" "_A

 S DIE="^DIC(7,",DA=I,DR=".01///"_N_";1///"_A_";9999999.01///"_C_";9999999.03///"_P_";9999999.05///"_R

 I $L($P(AUMPRV(AUMII,0),"^",6))>0 S DR=DR_";9999999.06///"_$P(AUMPRV(AUMII,0),"^",6)

 D ^DIE

 I $D(Y) D RSLT($J("",5)_$$M(0)_"EDIT PROVIDER CODE FAILED => "_L) Q

 D MODOK

 Q

EDTMOD ;EP - update education topics

 N AUMACT,AUMNAM,AUMMNE,AUMMJT,AUMOUTC,AUMSTD,AUMRES,FDA,NEWIEN,ERR,I,AUMCHG,AUMD0,AUMCNT,AUMIEN

 I '$D(EDTC) D RSLT("PATIENT EDUCATION TOPICS") S EDTC=""

 S AUMCHG=0,U="^",AUMIEN="",AUMACT=$P(L,U,1)

 S AUMNAM=$$CLEAN($P(L,U,2)),AUMMNE=$$CLEAN($P(L,U,3)),AUMMJT=$$CLEAN($P(L,U,4)),AUMOUTC=$P(L,U,5),AUMSTD=$P(L,U,6)

 S L=AUMMNE_$J("",13-$L(AUMMNE))_AUMNAM_$J("",51-$L(AUMNAM))_AUMMJT

 K AUMRES

 D FIND^DIC(9999999.09,"","@;.01;1;.06","PX",AUMNAM,,"B",,,"AUMRES")

 S AUMCNT=$P($G(AUMRES("DILIST",0)),"^",1)

 I AUMCNT=0 S AUMIEN="" ; No matches found, create new

 I AUMCNT=1 S AUMIEN=$P($G(AUMRES("DILIST",1,0)),"^",1) ; One match found, store IEN

 I AUMCNT>1 S AUMIEN=$P($G(AUMRES("DILIST",$P($G(AUMRES("DILIST",0)),"^",1),0)),"^",1)

 I 'AUMIEN  D

 . K AUMRES

 . D FIND^DIC(9999999.09,"","@;.01;1;.06","PX",AUMMNE,,"C","I ($P(^(0),U,3)'=1),($P(^(0),U)=$$UP^XLFSTR($P(^(0),U)))",,"AUMRES") ;

 . S AUMCNT=$P($G(AUMRES("DILIST",0)),"^",1)

 . I AUMCNT=0 S AUMIEN="" ; No matches found, create new

 . I AUMCNT=1 S AUMIEN=$P($G(AUMRES("DILIST",1,0)),"^",1) ; One match found, store IEN

 . I AUMCNT>1 S AUMIEN=$P($G(AUMRES("DILIST",$P($G(AUMRES("DILIST",0)),"^",1),0)),"^",1)

 ;

 I 'AUMIEN,$L(AUMACT)>0 D  Q

 . D RSLT($J("",5)_"INACTIVATE TOPIC FAILED : TOPIC DOES NOT EXIST => "_L)

 I 'AUMIEN D

 . K FDA,NEWIEN,ERR

 . S FDA(9999999.09,"+1,",.01)=AUMNAM ; Name (.01)

 . S FDA(9999999.09,"+1,",1)=AUMMNE ; Mnemonic (1)

 . D UPDATE^DIE(,"FDA","NEWIEN","ERR")

 . I $D(ERR) D ADDFAIL Q

 . S AUMIEN=NEWIEN(1),AUMCHG=1

 Q:'AUMIEN

 S AUMD0=$G(^AUTTEDT(AUMIEN,0))

 ;

 K FDA

 S FDA(9999999.09,AUMIEN_",",.01)=AUMNAM ; Name (.01)

 S FDA(9999999.09,AUMIEN_",",1)=AUMMNE ; Mnemonic (1)

 S FDA(9999999.09,AUMIEN_",",.06)=AUMMJT ; Major Topic (.06)

 S FDA(9999999.09,AUMIEN_",",.03)=$S($L(AUMACT)>0:1,1:"@") ; Inactive Flag (.03)

 D UPDATE^DIE(,"FDA",)

 I AUMD0'=$G(^AUTTEDT(AUMIEN,0)) S AUMCHG=1

 ;

 ; Outcome (1101) WP

 D TEXT(.AUMOUTC) ; convert string to WP array

 D WP^DIE(9999999.09,AUMIEN_",",1101,,"AUMOUTC")

 ;

 ; Standards (1102) WP

 D TEXT(.AUMSTD) ; convert string to WP array

 D WP^DIE(9999999.09,AUMIEN_",",1102,,"AUMSTD")

 ;

 I AUMCHG D @$S($D(NEWIEN):"ADDOK",$L(AUMACT)>0:"INAOK",1:"MODOK")

 ;

 K AUMRES,FDA

 D FIND^DIC(9999999.09,"","@;.01;1;.06","PX",AUMNAM,,"B","I ($P(^(0),U,3)'=1),(Y'=AUMIEN)",,"AUMRES")

 S AUMCNT=$P($G(AUMRES("DILIST",0)),"^",1)

 I AUMCNT>0 D RSLT("DUPLICATE NAMES FOUND FOR : "_AUMMNE_$J("",13-$L(AUMMNE))_AUMNAM)

 F I=1:1:AUMCNT  D

 . N L

 . S L=$P(AUMRES("DILIST",I,0),"^",3)_$J("",13-$L($P(AUMRES("DILIST",I,0),"^",3)))_$P(AUMRES("DILIST",I,0),"^",2)

 . S FDA(9999999.09,$P(AUMRES("DILIST",I,0),"^",1)_",",.03)="1" ; Inactive Flag (.03)

 . D DINAOK

 I AUMCNT D UPDATE^DIE(,"FDA",)

 ;

 K AUMRES,FDA

 D FIND^DIC(9999999.09,"","@;.01;1;.06","PX",AUMMNE,,"C","I ($P(^(0),U,3)'=1),(Y'=AUMIEN)",,"AUMRES")

 S AUMCNT=$P($G(AUMRES("DILIST",0)),"^",1)

 I AUMCNT>0 D RSLT("DUPLICATE MNEMONICS FOUND FOR : "_AUMMNE_$J("",13-$L(AUMMNE))_AUMNAM)

 F I=1:1:AUMCNT  D

 . N L

 . S L=$P(AUMRES("DILIST",I,0),"^",3)_$J("",13-$L($P(AUMRES("DILIST",I,0),"^",3)))_$P(AUMRES("DILIST",I,0),"^",2)

 . S FDA(9999999.09,$P(AUMRES("DILIST",I,0),"^",1)_",",.03)="1" ; Inactive Flag (.03)

 . D DINAOK

 I AUMCNT D UPDATE^DIE(,"FDA",)

 ;

 Q

MJTMOD ;EP - update major education topics

 N AUMNAM,AUMMNE,AUMRES,FDA,NEWIEN,ERR,AUMCHG,AUMD0,AUMCNT,AUMIEN

 I '$D(MJTC) D RSLT("PATIENT EDUCATION MAJOR TOPICS") S MJTC=""

 S AUMCHG=0,U="^",AUMIEN=""

 S AUMNAM=$$CLEAN($P(L,U,1)),AUMMNE=$$CLEAN($E($P(L,U,2),1,4))

 S L=AUMMNE_$J("",7-$L(AUMMNE))_AUMNAM

 K AUMRES

 D FIND^DIC(99999.91,"","@;.01;.02","PX",AUMMNE,,"B",,,"AUMRES")

 S AUMCNT=$P($G(AUMRES("DILIST",0)),"^",1)

 I AUMCNT=0 S AUMIEN="" ; No matches found, create new

 I AUMCNT=1 S AUMIEN=$P($G(AUMRES("DILIST",1,0)),"^",1) ; One match found, store IEN

 I AUMCNT>1 S AUMIEN=$P($G(AUMRES("DILIST",$P($G(AUMRES("DILIST",0)),"^",1),0)),"^",1)

 I 'AUMIEN D

 . K FDA,NEWIEN,ERR

 . S FDA(99999.91,"+1,",.01)=AUMNAM ; Name (.01)

 . S FDA(99999.91,"+1,",.02)=AUMMNE ; Abbreviation (.02)

 . D UPDATE^DIE(,"FDA","NEWIEN","ERR")

 . I $D(ERR) D ADDFAIL Q

 . S AUMIEN=NEWIEN(1),AUMCHG=1

 Q:'AUMIEN

 S AUMD0=$G(^AUTTEDMT(AUMIEN,0))

 ;

 K FDA

 S FDA(99999.91,AUMIEN_",",.01)=AUMNAM ; Name (.01)

 S FDA(99999.91,AUMIEN_",",.02)=AUMMNE ; Abbreviation (.02)

 D UPDATE^DIE(,"FDA",)

 I AUMD0'=$G(^AUTTEDMT(AUMIEN,0)) S AUMCHG=1

 ;

 I AUMCHG D @$S($D(NEWIEN):"ADDOK",1:"MODOK")

 Q

CLEAN(X) ;

 N CNT,AUMSTR

 S AUMSTR=X

 S CNT=0 F  S CNT=$F(X," -") Q:'CNT  S $E(X,CNT-2,CNT-1)="-"

 S CNT=0 F  S CNT=$F(X,"- ") Q:'CNT  S $E(X,CNT-2,CNT-1)="-"

 S CNT=0 F  S CNT=$F(X,"  ") Q:'CNT  S $E(X,CNT-2,CNT-1)=" "

 I $E(X,1)=" " S X=$E(X,2,$L(X))

 I $E(X,$L(X))=" " S X=$E(X,1,$L(X)-1)

 Q X

TEXT(X) ;

 N AUMSTR,I,J

 S AUMSTR=X,I=1,J=1

 K X

 F I=1:1:$L(AUMSTR,"|")  D

 . Q:$L($P(AUMSTR,"|",I))=0

 . S X(J)=$P(AUMSTR,"|",I),J=J+1

 Q

SVARS ;;A,C,E,F,L,M,N,O,P,R,S,T,V;Single-character work variables

 Q

PKLST ;EP - Check to see what EHR pick lists might be affected

 D RSLT("DISPLAYING EHR PICKLISTS CONTAINING INACTIVE EDUCATION TOPICS")

 N PKNAM,PK1,PK2,PK3,PXEDT,AUMDSP

 S PKNAM="",PK1=0

 F  S PK1=$O(^BGOEDTPR(PK1)) Q:PK1'?1N.N  D

 .S AUMDSP=1

 .S PK2="" F  S PK2=$O(^BGOEDTPR(PK1,PK2)) Q:PK2'?1N.N  D

 ..S:PK2=0 PKNAM=$P(^BGOEDTPR(PK1,PK2),U,1)

 ..S PK3=0 F  S PK3=$O(^BGOEDTPR(PK1,PK2,PK3)) Q:PK3'?1N.N  D

 ...S PXEDT=$P($G(^BGOEDTPR(PK1,PK2,PK3,0)),U,1)

 ...Q:PXEDT=""

 ...Q:$P($G(^AUTTEDT(PXEDT,0)),U,3)'=1

 ...N AUMMNE,AUMNAM,AUMINA

 ...S AUMMNE=$P(^AUTTEDT(PXEDT,0),"^",2),AUMNAM=$P(^AUTTEDT(PXEDT,0),"^",1),AUMINA=$$FMTE^XLFDT($P(^AUTTEDT(PXEDT,0),"^",5))

 ...I AUMDSP D RSLT(""),RSLT("INACTIVE TOPIC(S) FOUND IN EHR PICKLIST: "_$P(^BGOEDTPR(PK1,0),"^",1)) S AUMDSP=0

 ...D RSLT($J("",4)_AUMMNE_$J("",13-$L(AUMMNE))_"'"_AUMNAM_"'"_$J("",51-$L(AUMNAM))_AUMINA)

 ...Q

 ..Q

 .Q

 Q

AUMUPD4   ;IHS/OIT/NKD - SCB UPDATE  05/23/2012 ;

 +1       ;;12.0;TABLE MAINTENANCE;**3**;SEP 27,2011;Build 1

 +2       ;

ADDOK     ;----- "ADDED" MESSAGE

 +1        DO RSLT($JUSTIFY("",5)_"ADDED       : "_L)

 +2        QUIT 

 +3       ;

ADDFAIL   ;----- "FAILED" MESSAGE

 +1        DO RSLT($JUSTIFY("",5)_$$M(0)_"ADD FAILED => "_L)

 +2        QUIT 

 +3       ;

DASH      ;----- PRT DASH LINE

 +1        DO RSLT("")

 +2        DO RSLT($$REPEAT^XLFSTR("-",$SELECT($GET(IOM):IOM-10,1:70)))

 +3        DO RSLT("")

 +4        QUIT 

 +5       ;

DIE       ;----- DIE EDIT

 +1        NEW @($PIECE($TEXT(SVARS),";",3))

 +2        LOCK +(@(DIE_DA_")")):10

 +3       IF '$TEST

               DO RSLT($JUSTIFY("",5)_$$M(0)_"Entry '"_DIE_DA_"' IS LOCKED.  NOTIFY PROGRAMMER.")

               SET Y=1

               QUIT 

 +4        DO ^DIE

 +5        LOCK -(@(DIE_DA_")"))

 +6        QUIT 

 +7       ;

DIK       ;--- KILL ENTRY

 +1        NEW @($PIECE($TEXT(SVARS),";",3)),DIK

 +2        DO ^DIK

 +3        QUIT 

 +4       ;

FILE      ;--- FILE NEW ENTRY

 +1        NEW @($PIECE($TEXT(SVARS),";",3))

 +2        KILL DD,DO

 +3        SET DIC(0)="L"

 +4        DO FILE^DICN

 +5        KILL DIC,DLAYGO

 +6        QUIT 

 +7       ;

M(%)      ;--- ERROR MESSAGE

 +1        QUIT $SELECT(%=0:"ERROR : ",%=1:"NOT ADDED : ",1:"")

 +2       ;

MODOK     ;--- IF MOD OK 

 +1        DO RSLT($JUSTIFY("",5)_"CHANGED     : "_L)

 +2        QUIT 

 +3       ;

INAOK     ;--- IF INACTIVATE OK 

 +1        DO RSLT($JUSTIFY("",5)_"INACTIVATED : "_L)

 +2        QUIT 

 +3       ;

DINAOK    ;--- IF DUPLICATE INACTIVATE OK 

 +1        DO RSLT($JUSTIFY("",2)_"LOCAL DUPLICATE INACTIVATED : "_L)

 +2        QUIT 

 +3       ;

RSLT(%)   ;--- ISSUE MESSAGES DURING INSTALL

 +1        NEW @($PIECE($TEXT(SVARS),";",3))

 +2        DO MES^XPDUTL(%)

 +3        QUIT 

 +4       ;

IXDIC(DIC,DIC0,D,X,DLAYGO) ;

 +1       ;--- CALL TO FILEMAN IX^DIC

 +2        NEW @($PIECE($TEXT(SVARS),";",3))

 +3        SET DIC(0)=DIC0

 +4        KILL DIC0

 +5        IF '$GET(DLAYGO)

               KILL DLAYGO

 +6        DO IX^DIC

 +7        QUIT Y

 +8       ;

PCLASALL  ;EP --- PROVIDER TABLE UPDATE

 +1        NEW C,CI,A,S,I,II,L,N,NI,AUMI,AUMII

 +2       ;TRAVERSE THE D INDEX (CODE)

           SET C=$ORDER(^DIC(7,"D",""))

           SET A=""

 +3        FOR 

               IF $LENGTH(C)<1

                   QUIT 

               Begin DoDot:1

 +4       ;STORE THE IEN

                   SET I=$ORDER(^DIC(7,"D",C,""))

 +5       ;ITERATE THROUGH MASTER RETRIEVING CODES

 +6                FOR 

                       IF $LENGTH(I)<1

                           QUIT 

                       Begin DoDot:2

 +7                        NEW S

 +8       ;IF THE LOCAL CODE MATCHES, UPDATE THE LOCAL ENTRY AND REMOVE FROM THE MASTER

 +9                        FOR AUMII=1:1:$PIECE(AUMPRV(0),"^",4)

                               IF $DATA(AUMPRV(AUMII,0))

                                   SET CI=$PIECE(AUMPRV(AUMII,0),"^",1)

                                   IF $DATA(S)

                                       QUIT 

                                   Begin DoDot:3

 +10                                   IF CI=C

                                           DO RSLT("SERVICES RENDERED BY (PROVIDER) CODE CHANGES")

                                           DO PCLASDIE

                                           SET S=""

                                           KILL AUMPRV(AUMII,0)

                                   End DoDot:3

 +11      ;IF NOT FOUND IN THE MASTER, STORE IEN IN LOCAL VARIABLE

                           IF '$DATA(S)

                               SET A=A_I_"^"

 +12      ;ITERATE TO THE NEXT IEN WITH THIS CODE

                           SET I=$ORDER(^DIC(7,"D",C,I))

                       End DoDot:2

 +13      ;TRAVERSE TO THE NEXT CODE

                   SET C=$ORDER(^DIC(7,"D",C))

               End DoDot:1

 +14      ;ITERATE THROUGH THE STORED IENs

 +15       FOR AUMI=1:1

               SET I=$PIECE(A,"^",AUMI)

               IF $LENGTH(I)<1

                   QUIT 

               Begin DoDot:1

 +16               NEW S

 +17      ;STORE THE NAME

                   SET N=$PIECE(^DIC(7,I,0),"^",1)

 +18      ;ITERATE THROUGH MASTER RETRIEVING NAMES

 +19               FOR AUMII=1:1:$PIECE(AUMPRV(0),"^",4)

                       IF $DATA(AUMPRV(AUMII,0))

                           SET NI=$PIECE(AUMPRV(AUMII,0),"^",2)

                           IF $DATA(S)

                               QUIT 

                           Begin DoDot:2

 +20      ;IF THE LOCAL NAME MATCHES, UPDATE THE LOCAL ENTRY AND REMOVE FROM THE MASTER

 +21                           IF NI=N

                                   DO RSLT("SERVICES RENDERED BY (PROVIDER) NAME CHANGES")

                                   DO PCLASDIE

                                   SET S=""

                                   KILL AUMPRV(AUMII,0)

                           End DoDot:2

 +22      ;IF NOT FOUND, INACTIVATE LOCAL ENTRY

 +23               IF '$DATA(S)

                       Begin DoDot:2

 +24                       DO RSLT("SERVICES RENDERED BY (PROVIDER) INACTIVATE")

 +25                       SET L=$PIECE(^DIC(7,I,9999999),"^",1)_" "_N_" "_$PIECE(^DIC(7,I,9999999),"^",2)

 +26                       SET DIE="^DIC(7,"

                           SET DA=I

                           SET DR="9999999.06///"_DT

                           DO ^DIE

 +27                       IF $DATA(Y)

                               DO RSLT($JUSTIFY("",5)_$$M(0)_"INACTIVATE PROVIDER CODE FAILED => "_L)

                               QUIT 

 +28                       DO RSLT($JUSTIFY("",5)_"INACTIVATED : "_L)

                       End DoDot:2

               End DoDot:1

 +29      ;ITERATE THROUGH REMAINING MASTER ENTRIES AND ADD

 +30       FOR AUMI=1:1:$PIECE(AUMPRV(0),"^",4)

               IF $DATA(AUMPRV(AUMI,0))

                   Begin DoDot:1

 +31                   DO RSLT("SERVICES RENDERED BY (PROVIDER) ADD")

 +32                   SET C=$PIECE(AUMPRV(AUMI,0),"^",1)

                       SET N=$PIECE(AUMPRV(AUMI,0),"^",2)

                       SET A=$PIECE(AUMPRV(AUMI,0),"^",3)

                       SET P=$PIECE(AUMPRV(AUMI,0),"^",4)

                       SET R=$PIECE(AUMPRV(AUMI,0),"^",5)

 +33                   SET L=C_" "_N_$JUSTIFY("",(32-$LENGTH(N)))_A

 +34                   IF $DATA(^DIC(7,"D",C))

                           DO RSLT($JUSTIFY("",5)_$$M(1)_"PROVIDER CODE EXISTS => "_C)

                           DO RSLT("")

                           QUIT 

 +35                   SET DLAYGO=7

                       SET DIC="^DIC(7,"

                       SET X=N

                       SET DIC("DR")="1///"_A_";9999999.01///"_C_";9999999.03///"_P_";9999999.05///"_R

 +36                   DO FILE

 +37                   DO @$SELECT(Y>0:"ADDOK",1:"ADDFAIL")

 +38                   KILL AUMPRV(AUMI,0)

                   End DoDot:1

 +39       QUIT 

PCLASDIE  ;

 +1        NEW C,N,A,P,R,L,DIE,DA,DR

 +2        SET C=$PIECE(AUMPRV(AUMII,0),"^",1)

           SET N=$PIECE(AUMPRV(AUMII,0),"^",2)

           SET A=$PIECE(AUMPRV(AUMII,0),"^",3)

           SET P=$PIECE(AUMPRV(AUMII,0),"^",4)

           SET R=$PIECE(AUMPRV(AUMII,0),"^",5)

 +3        SET L=C_" "_N_" "_A

 +4        SET DIE="^DIC(7,"

           SET DA=I

           SET DR=".01///"_N_";1///"_A_";9999999.01///"_C_";9999999.03///"_P_";9999999.05///"_R

 +5        IF $LENGTH($PIECE(AUMPRV(AUMII,0),"^",6))>0

               SET DR=DR_";9999999.06///"_$PIECE(AUMPRV(AUMII,0),"^",6)

 +6        DO ^DIE

 +7        IF $DATA(Y)

               DO RSLT($JUSTIFY("",5)_$$M(0)_"EDIT PROVIDER CODE FAILED => "_L)

               QUIT 

 +8        DO MODOK

 +9        QUIT 

EDTMOD    ;EP - update education topics

 +1        NEW AUMACT,AUMNAM,AUMMNE,AUMMJT,AUMOUTC,AUMSTD,AUMRES,FDA,NEWIEN,ERR,I,AUMCHG,AUMD0,AUMCNT,AUMIEN

 +2        IF '$DATA(EDTC)

               DO RSLT("PATIENT EDUCATION TOPICS")

               SET EDTC=""

 +3        SET AUMCHG=0

           SET U="^"

           SET AUMIEN=""

           SET AUMACT=$PIECE(L,U,1)

 +4        SET AUMNAM=$$CLEAN($PIECE(L,U,2))

           SET AUMMNE=$$CLEAN($PIECE(L,U,3))

           SET AUMMJT=$$CLEAN($PIECE(L,U,4))

           SET AUMOUTC=$PIECE(L,U,5)

           SET AUMSTD=$PIECE(L,U,6)

 +5        SET L=AUMMNE_$JUSTIFY("",13-$LENGTH(AUMMNE))_AUMNAM_$JUSTIFY("",51-$LENGTH(AUMNAM))_AUMMJT

 +6        KILL AUMRES

 +7        DO FIND^DIC(9999999.09,"","@;.01;1;.06","PX",AUMNAM,,"B",,,"AUMRES")

 +8        SET AUMCNT=$PIECE($GET(AUMRES("DILIST",0)),"^",1)

 +9       ; No matches found, create new

           IF AUMCNT=0

               SET AUMIEN=""

 +10      ; One match found, store IEN

           IF AUMCNT=1

               SET AUMIEN=$PIECE($GET(AUMRES("DILIST",1,0)),"^",1)

 +11       IF AUMCNT>1

               SET AUMIEN=$PIECE($GET(AUMRES("DILIST",$PIECE($GET(AUMRES("DILIST",0)),"^",1),0)),"^",1)

 +12       IF 'AUMIEN

               Begin DoDot:1

 +13               KILL AUMRES

 +14      ;

                   DO FIND^DIC(9999999.09,"","@;.01;1;.06","PX",AUMMNE,,"C","I ($P(^(0),U,3)'=1),($P(^(0),U)=$$UP^XLFSTR($P(^(0),U)))",,"AUMRES")

 +15               SET AUMCNT=$PIECE($GET(AUMRES("DILIST",0)),"^",1)

 +16      ; No matches found, create new

                   IF AUMCNT=0

                       SET AUMIEN=""

 +17      ; One match found, store IEN

                   IF AUMCNT=1

                       SET AUMIEN=$PIECE($GET(AUMRES("DILIST",1,0)),"^",1)

 +18               IF AUMCNT>1

                       SET AUMIEN=$PIECE($GET(AUMRES("DILIST",$PIECE($GET(AUMRES("DILIST",0)),"^",1),0)),"^",1)

               End DoDot:1

 +19      ;

 +20       IF 'AUMIEN

               IF $LENGTH(AUMACT)>0

                   Begin DoDot:1

 +21                   DO RSLT($JUSTIFY("",5)_"INACTIVATE TOPIC FAILED : TOPIC DOES NOT EXIST => "_L)

                   End DoDot:1

                   QUIT 

 +22       IF 'AUMIEN

               Begin DoDot:1

 +23               KILL FDA,NEWIEN,ERR

 +24      ; Name (.01)

                   SET FDA(9999999.09,"+1,",.01)=AUMNAM

 +25      ; Mnemonic (1)

                   SET FDA(9999999.09,"+1,",1)=AUMMNE

 +26               DO UPDATE^DIE(,"FDA","NEWIEN","ERR")

 +27               IF $DATA(ERR)

                       DO ADDFAIL

                       QUIT 

 +28               SET AUMIEN=NEWIEN(1)

                   SET AUMCHG=1

               End DoDot:1

 +29       IF 'AUMIEN

               QUIT 

 +30       SET AUMD0=$GET(^AUTTEDT(AUMIEN,0))

 +31      ;

 +32       KILL FDA

 +33      ; Name (.01)

           SET FDA(9999999.09,AUMIEN_",",.01)=AUMNAM

 +34      ; Mnemonic (1)

           SET FDA(9999999.09,AUMIEN_",",1)=AUMMNE

 +35      ; Major Topic (.06)

           SET FDA(9999999.09,AUMIEN_",",.06)=AUMMJT

 +36      ; Inactive Flag (.03)

           SET FDA(9999999.09,AUMIEN_",",.03)=$SELECT($LENGTH(AUMACT)>0:1,1:"@")

 +37       DO UPDATE^DIE(,"FDA",)

 +38       IF AUMD0'=$GET(^AUTTEDT(AUMIEN,0))

               SET AUMCHG=1

 +39      ;

 +40      ; Outcome (1101) WP

 +41      ; convert string to WP array

           DO TEXT(.AUMOUTC)

 +42       DO WP^DIE(9999999.09,AUMIEN_",",1101,,"AUMOUTC")

 +43      ;

 +44      ; Standards (1102) WP

 +45      ; convert string to WP array

           DO TEXT(.AUMSTD)

 +46       DO WP^DIE(9999999.09,AUMIEN_",",1102,,"AUMSTD")

 +47      ;

 +48       IF AUMCHG

               DO @$SELECT($DATA(NEWIEN):"ADDOK",$LENGTH(AUMACT)>0:"INAOK",1:"MODOK")

 +49      ;

 +50       KILL AUMRES,FDA

 +51       DO FIND^DIC(9999999.09,"","@;.01;1;.06","PX",AUMNAM,,"B","I ($P(^(0),U,3)'=1),(Y'=AUMIEN)",,"AUMRES")

 +52       SET AUMCNT=$PIECE($GET(AUMRES("DILIST",0)),"^",1)

 +53       IF AUMCNT>0

               DO RSLT("DUPLICATE NAMES FOUND FOR : "_AUMMNE_$JUSTIFY("",13-$LENGTH(AUMMNE))_AUMNAM)

 +54       FOR I=1:1:AUMCNT

               Begin DoDot:1

 +55               NEW L

 +56               SET L=$PIECE(AUMRES("DILIST",I,0),"^",3)_$JUSTIFY("",13-$LENGTH($PIECE(AUMRES("DILIST",I,0),"^",3)))_$PIECE(AUMRES("DILIST",I,0),"^",2)