source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGFIPM.m@ 1765

Last change on this file since 1765 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1RGFIPM ;ALB/CJM-PROCESS FACILITY INTEGRATION MESSAGE ;08/27/99
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5**;30 Apr 99
3 ;
4XCHANGE(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 ;
69ADDERROR(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
Note: See TracBrowser for help on using the repository browser.