Routine: XUPSGS

XUPSGS ;ALB/CMC - GET, COMPARE/SET FOR FILE 200;DEC 31 2008

 ;;8.0;KERNEL;**551**;Jul 10, 1995;Build 5

GET(EN,ARRAY) ;GET DATA FROM FILE 200 AND SET INTO ARRAY

 ;EN is the internal entry for the person in file 200

 ;returned is 0 or -1^error message

 ;if returned value is 0 then ARRAY will also be defined with the data values

 N CNT,COR,NAME2,NAME

 I 'EN S ERROR="-1^Invalid parameter - no correlation ien passed." Q ERROR

 M COR(EN)=^VA(200,EN)

 I '$D(COR(EN)) S ERROR="-1^Correlation doesn't exist." Q ERROR

 S ARRAY("SourceSystemIEN")=$P($$SITE^VASITE(),"^") ;facility ien

 S ARRAY("SourceSystemID")=$P($$SITE^VASITE(),"^",3) ;facility station number

 S ARRAY("SourceID")=EN ;duz

 S NAME2=$P(COR(EN,0),"^")

 S NAME=$$HLNAME^XLFNAME(.NAME2,"","^")

 S ARRAY("Surname")=$P(NAME,"^") ;surname

 S ARRAY("FirstName")=$P(NAME,"^",2) ;first name

 S ARRAY("MiddleName")=$P(NAME,"^",3) ;middle name

 S ARRAY("Prefix")=$$GET1^DIQ(200,EN,"NAME COMPONENTS:PREFIX") ;prefix NOT PART OF .01, get from components file

 S ARRAY("Suffix")=$P(NAME,"^",4) ;suffix

 S ARRAY("DOB")=$P($G(COR(EN,1)),"^",3) ;dob

 S ARRAY("Gender")=$P($G(COR(EN,1)),"^",2) ;gender

 S ARRAY("SSN")=$P($G(COR(EN,1)),"^",9) ;ssn

 S ARRAY("ResAddL1")=$P($G(COR(EN,.11)),"^") ;street line 1

 S ARRAY("ResAddL2")=$P($G(COR(EN,.11)),"^",2) ;street line 2

 S ARRAY("ResAddL3")=$P($G(COR(EN,.11)),"^",3) ;street line 3

 S ARRAY("ResAddCity")=$P($G(COR(EN,.11)),"^",4) ;city

 S ARRAY("ResAddState")=$P($G(^DIC(5,+$P($G(COR(EN,.11)),"^",5),0)),"^",2) ;state

 S ARRAY("ResAddZip4")=$P($G(COR(EN,.11)),"^",6) ;zip

 S ARRAY("ResPhone")=$P($G(COR(EN,.13)),"^") ;HOME phone number

 S ARRAY("NPI")=$P($G(^VA(200,EN,"NPI")),"^") ;NPI

 S ARRAY("PAID")=$P($G(^VA(200,EN,450)),"^") ;PAID FILE IEN

 S ARRAY("EnumerateStart")=$P($G(^VA(200,EN,"MPI")),"^") ;Enumeration Initiated

 S ARRAY("EnumerateComp")=$P($G(^VA(200,EN,"MPI")),"^",2) ;Enumeration Completed

Q 0

UPD(EN,ARRAY,ERROR) ;update New Person entry EN

 ;  Input: EN is the IEN in file 200 to be updated

 ;  ARRAY is an array with the values to be updated

 ;  ERROR is an array that will return any error messages for any field that fails to update

 ;  Returns:  -1^error text if unsuccessful

 ;            0 if OK - doesn't mean ERROR isn't defined

 N CNT,COR,ECNT,FDA,FLDCNT,IDCNT,IEN,MIEN,NAMEDIT,MPIERR,RET,TFUPDATE

 K ERROR ;clean up in case someone passed it in

 I 'EN S ERROR="-1^Invalid parameter - no ien passed." Q ERROR

 L +^VA(200,EN):600 ;lock New Person file entry

 M COR(EN)=^VA(200,EN) ;get current New Person file data

 D BLDFDA(.ARRAY,.COR,.FDA) ;build the fda array to update NEW PERSON file entry

 I $D(FDA) D FILE^DIE("E","FDA","XUERR") I $D(XUERR("DIERR")) D LOGERR(.XUERR)

 ;file correlation data and capture any text of errors

 I $G(ECNT),(ECNT=FLDCNT) S ERROR="-1^Unable to begin updating field(s) in correlation for ien # "_IEN_"." L -^VA(200,EN) Q ERROR ;if no edits occurred then return error condition

 L -^VA(200,EN) ;unlock New Person file entry

 Q 0 ;no problems updating New Person file entry

LOGERR(XUERR) ;build error array from fileman's error array

 N ECNT,E

 S ECNT=1,E=0

 F  S E=$O(XUERR("DIERR",E)) Q:'E  I $D(XUERR("DIERR",1,"TEXT",1)) S ECNT=ECNT+1,ERROR(ECNT)=$G(XUERR("DIERR",E,"TEXT",1)) ;capture text of errors

BLDFDA(NEWCOR,COR,FDA)   ;build the FDA array to create the correlation

 ;will only create FDA if existing data is different from updated data

 K FDA

 I $G(NEWCOR("Surname")) S NEWCOR("NAME")=$G(NEWCOR("Surname"))_","_$G(NEWCOR("FirstName"))_" "_$G(NEWCOR("MiddleName"))_" "_$G(NEWCOR("Suffix")) D

 .I $G(NEWCOR("NAME"))'="",$G(NEWCOR("NAME"))'=$P($G(COR(EN,0)),"^") S FDA(200,EN_",",.01)=NEWCOR("NAME")

 I $G(NEWCOR("DOB"))'="",(NEWCOR("DOB")'=$P($G(COR(EN,1)),"^",3)),$S(NEWCOR("DOB")="@"&($P($G(COR(EN,1)),"^",3)=""):0,1:1) D

 .S FDA(200,EN_",",5)=$$FMTE^XLFDT(NEWCOR("DOB")) ;dob

 I $G(NEWCOR("Gender"))'="",(NEWCOR("Gender")'=$P($G(COR(EN,1)),"^",2)),$S(NEWCOR("Gender")="@"&($P($G(COR(EN,1)),"^",2)=""):0,1:1) D

 .S FDA(200,EN_",",4)=NEWCOR("Gender") ;gender

 I $G(NEWCOR("SSN"))'="",(NEWCOR("SSN")'=$P($G(COR(EN,1)),"^",9)),$S(NEWCOR("SSN")="@"&($P($G(COR(EN,1)),"^",9)=""):0,1:1) D

 .S FDA(200,EN_",",9)=NEWCOR("SSN") ;ssn

 I $G(NEWCOR("ResAddL1"))'="",(NEWCOR("ResAddL1")'=$P($G(COR(EN,.11)),"^")),$S(NEWCOR("ResAddL1")="@"&($P($G(COR(EN,.11)),"^")=""):0,1:1) D

 .S FDA(200,EN_",",.111)=NEWCOR("ResAddL1") ;street line 1

 I $G(NEWCOR("ResAddL2"))'="",(NEWCOR("ResAddL2")'=$P($G(COR(EN,.11)),"^",2)),$S(NEWCOR("ResAddL2")="@"&($P($G(COR(EN,.11)),"^",2)=""):0,1:1) D

 .S FDA(200,EN_",",.112)=NEWCOR("ResAddL2") ;street line 2

 I $G(NEWCOR("ResAddL3"))'="",(NEWCOR("ResAddL3")'=$P($G(COR(EN,.11)),"^",3)),$S(NEWCOR("ResAddL3")="@"&($P($G(COR(EN,.11)),"^",3)=""):0,1:1) D

 .S FDA(200,IEN_",",.113)=NEWCOR("ResAddL3") ;street line 3

 I $G(NEWCOR("ResAddCity"))'="",(NEWCOR("ResAddCity")'=$P($G(COR(EN,.11)),"^",4)),$S(NEWCOR("ResAddCity")="@"&($P($G(COR(EN,.11)),"^",4)=""):0,1:1) D

 .S FDA(200,EN_",",.114)=NEWCOR("ResAddCity") ;city

 I $G(NEWCOR("ResAddState"))'="",(NEWCOR("ResAddState")'=$P($G(^DIC(5,+$P($G(COR(EN,.11)),"^",5),0)),"^",2)),$S(NEWCOR("ResAddState")="@"&($P($G(COR(EN,.11)),"^",5)=""):0,1:1) D

 .N RESSTIEN S RESSTIEN=NEWCOR("ResAddState"),RESSTIEN=$S(RESSTIEN="@":"@",RESSTIEN="FG":$O(^DIC(5,"B","FOREIGN COUNTRY",0)),RESSTIEN="OT":$O(^DIC(5,"B","OTHER",0)),RESSTIEN="EU":$O(^DIC(5,"B","EUROPE",0)),1:$O(^DIC(5,"C",RESSTIEN,0)))

 .S FDA(200,EN_",",.115)=$S(RESSTIEN="@":"@",1:"`"_RESSTIEN) ;state

 I $G(NEWCOR("ResAddZip4"))'="",(NEWCOR("ResAddZip4")'=$P($G(COR(EN,.11)),"^",6)),$S(NEWCOR("ResAddZip4")="@"&($P($G(COR(EN,.11)),"^",6)=""):0,1:1) D

 .S FDA(200,EN_",",.116)=NEWCOR("ResAddZip4") ;zip

 I $G(NEWCOR("ResPhone"))'="",(NEWCOR("ResPhone")'=$P($G(COR(EN,.13)),"^")),$S(NEWCOR("ResPhone")="@"&($P($G(COR(EN,.13)),"^")=""):0,1:1) D

 .S FDA(200,EN_",",.131)=NEWCOR("ResPhone") ;phone number

XUPSGS    ;ALB/CMC - GET, COMPARE/SET FOR FILE 200;DEC 31 2008

 +1       ;;8.0;KERNEL;**551**;Jul 10, 1995;Build 5

 +2       ;

 +3        QUIT

GET(EN,ARRAY) ;GET DATA FROM FILE 200 AND SET INTO ARRAY

 +1       ;EN is the internal entry for the person in file 200

 +2       ;returned is 0 or -1^error message

 +3       ;if returned value is 0 then ARRAY will also be defined with the data values

 +4        NEW CNT,COR,NAME2,NAME

 +5        IF 'EN

               SET ERROR="-1^Invalid parameter - no correlation ien passed."

               QUIT ERROR

 +6        MERGE COR(EN)=^VA(200,EN)

 +7        IF '$DATA(COR(EN))

               SET ERROR="-1^Correlation doesn't exist."

               QUIT ERROR

 +8       ;facility ien

           SET ARRAY("SourceSystemIEN")=$PIECE($$SITE^VASITE(),"^")

 +9       ;facility station number

           SET ARRAY("SourceSystemID")=$PIECE($$SITE^VASITE(),"^",3)

 +10      ;duz

           SET ARRAY("SourceID")=EN

 +11       SET NAME2=$PIECE(COR(EN,0),"^")

 +12       SET NAME=$$HLNAME^XLFNAME(.NAME2,"","^")

 +13      ;surname

           SET ARRAY("Surname")=$PIECE(NAME,"^")

 +14      ;first name

           SET ARRAY("FirstName")=$PIECE(NAME,"^",2)

 +15      ;middle name

           SET ARRAY("MiddleName")=$PIECE(NAME,"^",3)

 +16      ;prefix NOT PART OF .01, get from components file

           SET ARRAY("Prefix")=$$GET1^DIQ(200,EN,"NAME COMPONENTS:PREFIX")

 +17      ;suffix

           SET ARRAY("Suffix")=$PIECE(NAME,"^",4)

 +18      ;dob

           SET ARRAY("DOB")=$PIECE($GET(COR(EN,1)),"^",3)

 +19      ;gender

           SET ARRAY("Gender")=$PIECE($GET(COR(EN,1)),"^",2)

 +20      ;ssn

           SET ARRAY("SSN")=$PIECE($GET(COR(EN,1)),"^",9)

 +21      ;street line 1

           SET ARRAY("ResAddL1")=$PIECE($GET(COR(EN,.11)),"^")

 +22      ;street line 2

           SET ARRAY("ResAddL2")=$PIECE($GET(COR(EN,.11)),"^",2)

 +23      ;street line 3

           SET ARRAY("ResAddL3")=$PIECE($GET(COR(EN,.11)),"^",3)

 +24      ;city

           SET ARRAY("ResAddCity")=$PIECE($GET(COR(EN,.11)),"^",4)

 +25      ;state

           SET ARRAY("ResAddState")=$PIECE($GET(^DIC(5,+$PIECE($GET(COR(EN,.11)),"^",5),0)),"^",2)

 +26      ;zip

           SET ARRAY("ResAddZip4")=$PIECE($GET(COR(EN,.11)),"^",6)

 +27      ;HOME phone number

           SET ARRAY("ResPhone")=$PIECE($GET(COR(EN,.13)),"^")

 +28      ;NPI

           SET ARRAY("NPI")=$PIECE($GET(^VA(200,EN,"NPI")),"^")

 +29      ;PAID FILE IEN

           SET ARRAY("PAID")=$PIECE($GET(^VA(200,EN,450)),"^")

 +30      ;Enumeration Initiated

           SET ARRAY("EnumerateStart")=$PIECE($GET(^VA(200,EN,"MPI")),"^")

 +31      ;Enumeration Completed

           SET ARRAY("EnumerateComp")=$PIECE($GET(^VA(200,EN,"MPI")),"^",2)

 +32       QUIT 0

 +33      ;

UPD(EN,ARRAY,ERROR) ;update New Person entry EN

 +1       ;  Input: EN is the IEN in file 200 to be updated

 +2       ;  ARRAY is an array with the values to be updated

 +3       ;  ERROR is an array that will return any error messages for any field that fails to update

 +4       ;  Returns:  -1^error text if unsuccessful

 +5       ;            0 if OK - doesn't mean ERROR isn't defined

 +6       ;

 +7        NEW CNT,COR,ECNT,FDA,FLDCNT,IDCNT,IEN,MIEN,NAMEDIT,MPIERR,RET,TFUPDATE

 +8       ;clean up in case someone passed it in

           KILL ERROR

 +9        IF 'EN

               SET ERROR="-1^Invalid parameter - no ien passed."

               QUIT ERROR

 +10      ;

 +11      ;lock New Person file entry

           LOCK +^VA(200,EN):600

 +12      ;

 +13      ;get current New Person file data

           MERGE COR(EN)=^VA(200,EN)

 +14      ;

 +15      ;build the fda array to update NEW PERSON file entry

           DO BLDFDA(.ARRAY,.COR,.FDA)

 +16      ;

 +17       IF $DATA(FDA)

               DO FILE^DIE("E","FDA","XUERR")

               IF $DATA(XUERR("DIERR"))

                   DO LOGERR(.XUERR)

 +18      ;file correlation data and capture any text of errors

 +19      ;if no edits occurred then return error condition

           IF $GET(ECNT)

               IF (ECNT=FLDCNT)

                   SET ERROR="-1^Unable to begin updating field(s) in correlation for ien # "_IEN_"."

                   LOCK -^VA(200,EN)

                   QUIT ERROR

 +20      ;

 +21      ;unlock New Person file entry

           LOCK -^VA(200,EN)

 +22      ;

 +23      ;no problems updating New Person file entry

           QUIT 0

 +24      ;

LOGERR(XUERR) ;build error array from fileman's error array

 +1        NEW ECNT,E

 +2        SET ECNT=1

           SET E=0

 +3       ;capture text of errors

FOR

               SET E=$ORDER(XUERR("DIERR",E))

               IF 'E

                   QUIT

               IF $DATA(XUERR("DIERR",1,"TEXT",1))

                   SET ECNT=ECNT+1

                   SET ERROR(ECNT)=$GET(XUERR("DIERR",E,"TEXT",1))

 +4        QUIT

 +5       ;

BLDFDA(NEWCOR,COR,FDA) ;build the FDA array to create the correlation

 +1       ;will only create FDA if existing data is different from updated data

 +2        KILL FDA

 +3       ;

 +4        IF $GET(NEWCOR("Surname"))

               SET NEWCOR("NAME")=$GET(NEWCOR("Surname"))_","_$GET(NEWCOR("FirstName"))_" "_$GET(NEWCOR("MiddleName"))_" "_$GET(NEWCOR("Suffix"))

               Begin DoDot:1

 +5                IF $GET(NEWCOR("NAME"))'=""

                       IF $GET(NEWCOR("NAME"))'=$PIECE($GET(COR(EN,0)),"^")

                           SET FDA(200,EN_",",.01)=NEWCOR("NAME")

               End DoDot:1

 +6       ;

 +7        IF $GET(NEWCOR("DOB"))'=""

               IF (NEWCOR("DOB")'=$PIECE($GET(COR(EN,1)),"^",3))

                   IF $SELECT(NEWCOR("DOB")="@"&($PIECE($GET(COR(EN,1)),"^",3)=""):0,1:1)

                       Begin DoDot:1

 +8       ;dob

                           SET FDA(200,EN_",",5)=$$FMTE^XLFDT(NEWCOR("DOB"))

                       End DoDot:1

 +9       ;

 +10       IF $GET(NEWCOR("Gender"))'=""

               IF (NEWCOR("Gender")'=$PIECE($GET(COR(EN,1)),"^",2))

                   IF $SELECT(NEWCOR("Gender")="@"&($PIECE($GET(COR(EN,1)),"^",2)=""):0,1:1)

                       Begin DoDot:1

 +11      ;gender

                           SET FDA(200,EN_",",4)=NEWCOR("Gender")

                       End DoDot:1

 +12      ;

 +13       IF $GET(NEWCOR("SSN"))'=""

               IF (NEWCOR("SSN")'=$PIECE($GET(COR(EN,1)),"^",9))

                   IF $SELECT(NEWCOR("SSN")="@"&($PIECE($GET(COR(EN,1)),"^",9)=""):0,1:1)

                       Begin DoDot:1

 +14      ;ssn

                           SET FDA(200,EN_",",9)=NEWCOR("SSN")

                       End DoDot:1

 +15      ;

 +16       IF $GET(NEWCOR("ResAddL1"))'=""

               IF (NEWCOR("ResAddL1")'=$PIECE($GET(COR(EN,.11)),"^"))

                   IF $SELECT(NEWCOR("ResAddL1")="@"&($PIECE($GET(COR(EN,.11)),"^")=""):0,1:1)

                       Begin DoDot:1

 +17      ;street line 1

                           SET FDA(200,EN_",",.111)=NEWCOR("ResAddL1")

                       End DoDot:1

 +18       IF $GET(NEWCOR("ResAddL2"))'=""

               IF (NEWCOR("ResAddL2")'=$PIECE($GET(COR(EN,.11)),"^",2))

                   IF $SELECT(NEWCOR("ResAddL2")="@"&($PIECE($GET(COR(EN,.11)),"^",2)=""):0,1:1)

                       Begin DoDot:1

 +19      ;street line 2

                           SET FDA(200,EN_",",.112)=NEWCOR("ResAddL2")

                       End DoDot:1

 +20       IF $GET(NEWCOR("ResAddL3"))'=""

               IF (NEWCOR("ResAddL3")'=$PIECE($GET(COR(EN,.11)),"^",3))

                   IF $SELECT(NEWCOR("ResAddL3")="@"&($PIECE($GET(COR(EN,.11)),"^",3)=""):0,1:1)

                       Begin DoDot:1

 +21      ;street line 3

                           SET FDA(200,IEN_",",.113)=NEWCOR("ResAddL3")

                       End DoDot:1

 +22       IF $GET(NEWCOR("ResAddCity"))'=""

               IF (NEWCOR("ResAddCity")'=$PIECE($GET(COR(EN,.11)),"^",4))

                   IF $SELECT(NEWCOR("ResAddCity")="@"&($PIECE($GET(COR(EN,.11)),"^",4)=""):0,1:1)

                       Begin DoDot:1

 +23      ;city

                           SET FDA(200,EN_",",.114)=NEWCOR("ResAddCity")

                       End DoDot:1

 +24       IF $GET(NEWCOR("ResAddState"))'=""

               IF (NEWCOR("ResAddState")'=$PIECE($GET(^DIC(5,+$PIECE($GET(COR(EN,.11)),"^",5),0)),"^",2))

                   IF $SELECT(NEWCOR("ResAddState")="@"&($PIECE($GET(COR(EN,.11)),"^",5)=""):0,1:1)

                       Begin DoDot:1

 +25                       NEW RESSTIEN

                           SET RESSTIEN=NEWCOR("ResAddState")

                           SET RESSTIEN=$SELECT(RESSTIEN="@":"@",RESSTIEN="FG":$ORDER(^DIC(5,"B","FOREIGN COUNTRY",0)),RESSTIEN="OT":$ORDER(^DIC(5,"B","OTHER",0)),RESSTIEN="EU":$ORDER(^DIC(5,"B","EUROPE",0)),1:$ORDER(^DIC(5,"C",RESSTIEN,0)))

 +26      ;state

                           SET FDA(200,EN_",",.115)=$SELECT(RESSTIEN="@":"@",1:"`"_RESSTIEN)

                       End DoDot:1

 +27       IF $GET(NEWCOR("ResAddZip4"))'=""

               IF (NEWCOR("ResAddZip4")'=$PIECE($GET(COR(EN,.11)),"^",6))

                   IF $SELECT(NEWCOR("ResAddZip4")="@"&($PIECE($GET(COR(EN,.11)),"^",6)=""):0,1:1)

                       Begin DoDot:1

 +28      ;zip

                           SET FDA(200,EN_",",.116)=NEWCOR("ResAddZip4")

                       End DoDot:1

 +29      ;

 +30       IF $GET(NEWCOR("ResPhone"))'=""

               IF (NEWCOR("ResPhone")'=$PIECE($GET(COR(EN,.13)),"^"))

                   IF $SELECT(NEWCOR("ResPhone")="@"&($PIECE($GET(COR(EN,.13)),"^")=""):0,1:1)

                       Begin DoDot:1

 +31      ;phone number

                           SET FDA(200,EN_",",.131)=NEWCOR("ResPhone")

                       End DoDot:1

 +32       QUIT

XUPSGS.m