| 1 | RGFIPM ;ALB/CJM-PROCESS FACILITY INTEGRATION MESSAGE ;08/27/99
|
|---|
| 2 | ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5**;30 Apr 99
|
|---|
| 3 | ;
|
|---|
| 4 | XCHANGE(DFN,LEGSN,PRIMSN,ERROR) ;
|
|---|
| 5 | ;Description: If the CMOR is the legacy site it changes to the
|
|---|
| 6 | ;primary site. If the legacy system is on the treating facility list
|
|---|
| 7 | ;it is removed. If the primary system is not on the treating facility
|
|---|
| 8 | ;list it is added.The subscription for the legacy system is terminated.
|
|---|
| 9 | ;If the primary system is not on the subscriber list it is added.
|
|---|
| 10 | ;
|
|---|
| 11 | ;Input:
|
|---|
| 12 | ; DFN - ien of patient (required)
|
|---|
| 13 | ; LEGSN- station # of the legacy site (required)-
|
|---|
| 14 | ; PRIMSN - station # of the primary site (required)
|
|---|
| 15 | ;Output:
|
|---|
| 16 | ; Function Value - 0 if any error condition encountered, 1 otherwise
|
|---|
| 17 | ; ERROR() - (optional,pass by reference) - an array of error messages
|
|---|
| 18 | ;
|
|---|
| 19 | ;Variables:
|
|---|
| 20 | ; PRIMIEN - ien of the primary site in the Institution file
|
|---|
| 21 | ; PRIMLINK - name of logical link for primary site
|
|---|
| 22 | ; FOUNDERR - flag set to 1 if an error is found
|
|---|
| 23 | ; MPIDATA() - array containing MPI data for this patient
|
|---|
| 24 | ;
|
|---|
| 25 | N PRIMIEN,PRIMLINK,FOUNDERR,MPIDATA,RETURN,LEGIEN
|
|---|
| 26 | ;
|
|---|
| 27 | D
|
|---|
| 28 | .S FOUNDERR=0
|
|---|
| 29 | .I DFN,LEGSN,PRIMSN
|
|---|
| 30 | .E D ADDERROR("INPUT PARAMETER MISSING, TAG=XCHANGE,RTN=RGFIPM",6) Q
|
|---|
| 31 | .;
|
|---|
| 32 | .S PRIMIEN=$$LKUP^XUAF4(PRIMSN)
|
|---|
| 33 | .I 'PRIMIEN D ADDERROR("INSTITUTION LOOKUP FAILED, STATION# = "_PRIMSN,229) Q
|
|---|
| 34 | .S LEGIEN=$$LKUP^XUAF4(LEGSN)
|
|---|
| 35 | .I 'LEGIEN D ADDERROR("INSTITUTION LOOKUP FAILED, STATION# = "_LEGSN,229)
|
|---|
| 36 | .;
|
|---|
| 37 | .D GETALL^RGFIU(DFN,.MPIDATA)
|
|---|
| 38 | .;
|
|---|
| 39 | .;if the legacy site is the CMOR change it to the primary site
|
|---|
| 40 | .I MPIDATA("CMOR")=LEGSN,($$CHANGE^MPIF001(DFN,PRIMIEN)'=1) D ADDERROR("ERROR CHANGING CMOR TO "_PRIMSN,6)
|
|---|
| 41 | .;
|
|---|
| 42 | .;if the legacy system is on the TF list, remove it
|
|---|
| 43 | .I $D(MPIDATA("TF",LEGSN)) S RETURN=$$DELETETF^VAFCTFU(MPIDATA("ICN"),MPIDATA("TF",LEGSN,"INSTIEN")) I +RETURN D ADDERROR("FAILURE TO DELETE TREATING FACILITY = "_LEGSN,6)
|
|---|
| 44 | .;
|
|---|
| 45 | .;if the primary site is not on the TF list, then add it OR
|
|---|
| 46 | .;its on the Tf list but with an earlier date than the legacy and legacy has an event reason OR legacy has an event reason and primary doesn't, change it
|
|---|
| 47 | .I ('$D(MPIDATA("TF",PRIMSN)))!($G(MPIDATA("TF",PRIMSN,"LASTDATE"))<$G(MPIDATA("TF",LEGSN,"LASTDATE"))&$G(MPIDATA("TF",LEGSN,"EVENT")))!($G(MPIDATA("TF",LEGSN,"EVENT"))&('$G(MPIDATA("TF",PRIMSN,"EVENT")))) D
|
|---|
| 48 | ..;should not be necessar to delete old TF entry for primary before calling FILE^VACTFU
|
|---|
| 49 | ..;I $D(MPIDATA("TF",PRIMSN)) S RETURN=$$DELETETF^VAFCTFU(MPIDATA("ICN"),MPIDATA("TF",PRIMSN,"INSTIEN"))
|
|---|
| 50 | ..;
|
|---|
| 51 | ..D FILE^VAFCTFU(DFN,PRIMIEN_"^"_$G(MPIDATA("TF",LEGSN,"LASTDATE"))_"^"_$G(MPIDATA("TF",LEGSN,"EVENT")),1)
|
|---|
| 52 | .;
|
|---|
| 53 | .Q:'MPIDATA("SUB")
|
|---|
| 54 | .;Terminate the subscription of legacy site
|
|---|
| 55 | .I LEGIEN,LEGIEN'=+$$SITE^VASITE D UPD^HLSUB(MPIDATA("SUB"),$$GETLINK^RGFIU(LEGIEN),,,$$NOW^XLFDT)
|
|---|
| 56 | .;
|
|---|
| 57 | .;if the primary site is not on the subscription list then add it - unless this site is the primary site!
|
|---|
| 58 | .D
|
|---|
| 59 | ..Q:(($P($$SITE^VASITE(),"^",3))=PRIMSN)
|
|---|
| 60 | ..;Add primary site as a subscriber
|
|---|
| 61 | ..N ERR
|
|---|
| 62 | ..;Get the logical link for the primary site
|
|---|
| 63 | ..S PRIMLINK=$$GETLINK^RGFIU(PRIMIEN)
|
|---|
| 64 | ..I PRIMLINK="" D ADDERROR("FAILURE TO ADD SUBSCRIPTION FOR STATION# = "_PRIMSN,224) Q
|
|---|
| 65 | ..D UPD^HLSUB(MPIDATA("SUB"),PRIMLINK,0,,"@",,.ERR)
|
|---|
| 66 | ..I $O(ERR(0)) D ADDERROR("FAILURE TO ADD SUBSCRIPTION FOR STATION# = "_PRIMSN,6)
|
|---|
| 67 | Q $S(FOUNDERR:0,1:1)
|
|---|
| 68 | ;
|
|---|
| 69 | ADDERROR(MSG,CODE) ;
|
|---|
| 70 | ;Description: Puts the error message on a list. If an exception type code is passed the exception handler will be called.
|
|---|
| 71 | ;
|
|---|
| 72 | ;Input:
|
|---|
| 73 | ; MSG - message text
|
|---|
| 74 | ; CODE - a CIRN exception type (optional)
|
|---|
| 75 | ; ERROR() - this is the array where errors are being tracked
|
|---|
| 76 | ; DFN - the patient DFN should be defined
|
|---|
| 77 | ;Output:
|
|---|
| 78 | ; ERROR() array has the addtional error entered
|
|---|
| 79 | ; FOUNDERR is set to 1, is a flag indicating that an error was encountered
|
|---|
| 80 | ;
|
|---|
| 81 | N NEXT
|
|---|
| 82 | S FOUNDERR=1
|
|---|
| 83 | S NEXT=($O(ERROR(-1))+1)
|
|---|
| 84 | S ERROR(NEXT)=MSG
|
|---|
| 85 | S ERROR(NEXT,"CODE")=$G(CODE)
|
|---|
| 86 | I $G(CODE),$G(DFN) D EXC^RGFIU(CODE,"FACILITY INTEGRATION ERROR: "_$P($$ERROR^RGFIPM1(MSG,CODE,$$ICN^RGFIU(DFN)),"^",2),DFN)
|
|---|
| 87 | Q
|
|---|
