source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFMER.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1MPIFMER ;SF/MJM,CMC-Merge patient ICN ;JUL 14, 1998
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**9,21**;30 Apr 99
3 ;
4 ; *** THIS ROUTINE IS TO BE REPLACED BY THE LINK/UNLINK MESSAGES
5 ; *** SINCE MESSAGES ARE NOT BEING USED BY ANYONE, PLACING QUIT
6 ; **** AT ALL ENTRY POINTS.
7 ;
8 ;Notify MPI and other TF of change to patient's ICN
9 ;
10MER(PDFN,OLD,ERROR,FLG) ;
11 Q
12 ;Q:$D(MPIFMER)
13 ;Q:$E(OLD,1,3)=$E($P($$SITE^VASITE,"^",3),1,3)
14 ;; ^ LOCAL ICN being resolved don't send to CIRN sites OR MPI
15 ;; but others may want to know Local Resolved,
16 ;;If other want to know resolved look at x-ref on 991.01 field in file 2
17 ;I '$G(PDFN) S ERROR="DFN VARIABLE UNDEFINED" Q
18 ;Q:OLD=""
19 ;I '$D(FLG) S FLG=""
20 ;I '$D(ERROR) S ERROR=""
21 ;S ZTRTN="MER2^MPIFMER",ZTDESC="MERGE ICN JOB",ZTIO=""
22 ;D NOW^%DTC S ZTDTH=% K %,X
23 ;I $D(DUZ) S ZTSAVE("DUZ")=DUZ
24 ;S ZTSAVE("PDFN")=PDFN,ZTSAVE("OLD")=OLD,ZTSAVE("ERROR")=ERROR,ZTSAVE("FLG")=FLG
25 ;D ^%ZTLOAD
26 ;K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
27 ;Q
28MER2 ;
29 Q
30 ;N RGLOG,CNT,HLA,HL,RGLINK,HOME,SUB,ICN,TMP,PARENT,RGL,CLIENT,I,TD,X,CMOR,HERE,%
31 ;Q:$E(OLD,1,3)=$E($P($$SITE^VASITE,"^",3),1,3)
32 ;; ^ LOCAL ICN being resolved don't send to CIRN sites or MPI
33 ;; though others may want to know Local has been resolved.
34 ;;If other want to know resolved look at x-ref on 991.01 field in file 2
35 ;Q:'$G(PDFN)
36 ;Q:+$$GETICN^MPIF001(PDFN)<0
37 ;; ^ If no ICN currently don't send mesg
38 ;S CNT=0,HL=0,ERROR="",CLIENT="MPIF A30 SERVER"
39 ;D NOW^%DTC S TD=$$HLDATE^HLFNC(%,"DT")
40 ;S CMOR=+$$PAT^MPIFNQ(PDFN),HERE=+$$SITE^VASITE()
41 ;I CMOR'=HERE,FLG="" S ERROR="PATIENT'S CMOR MUST BE THIS FACILITY" D EXC^MPIFDEL(PDFN,ERROR,226) Q
42 ;D INIT^HLFNC2(CLIENT,.HL)
43 ;I HL S ERROR=HL D EXC^MPIFDEL(PDFN,ERROR,220) Q
44 ;S CNT=CNT+1,HLA("HLS",CNT)="EVN"_HL("FS")_"A30"_HL("FS")_TD_HL("FS")_HL("FS")_HL("FS")
45 ;S CNT=CNT+1,HLA("HLS",CNT)=$$EN^VAFCPID(PDFN,"1,2,3,4,5,6,7,8,10,13,14,17,19,11")
46 ;S CNT=CNT+1,HLA("HLS",CNT)="MRG"_HL("FS")_OLD
47 ;D GENERATE^HLMA(CLIENT,"LM",1,.HLRST,"",.HL)
48 ;I 'HLRST S ERROR=HLRST D EXC^MPIFDEL(PDFN,ERROR,220)
49 ;Q
50LINKS ; gets links to send messages to, including mpi
51 ; Currently only the MPI will get Change ICN msgs.
52 Q
53 ;N SUB,MPI
54 ;Q:$P($$GETICN^MPIF001(PDFN),1,3)=$P($$SITE^VASITE(),3)
55 ;S SUB=$P($G(^DPT(PDFN,"MPI")),"^",5)
56 ;I SUB'="" D GET^HLSUB(SUB,0,"MPIF A30",.HLL)
57 ;S MPI=$$MPILINK^MPIFAPI() D
58 ;.I $P($G(MPI),U)'=-1 S HLL("LINKS",999)="MPIF A30"_"^"_MPI
59 ;.I $P($G(MPI),U)=-1 N RGLOG D START^RGHLLOG(HLMTIEN,"","") D EXC^RGHLLOG(224,"No MPI link defined in CIRN Site Parameter file") D STOP^RGHLLOG(0)
60 ;Q
61 ;
62IN ;process inbound Merge ICN Message - currently not used.
63 Q
64 ;N I,CNT,NODE,SENDER,NEWICN,OLDICN,PDFN,CMOR,ERR,DA,DIE,DR,SEP,CHK
65 ;K ^XTMP($J,"MPIFMER")
66 ;; get message
67 ;F I=1:1 X HLNEXT Q:HLQUIT'>0 S ^XTMP($J,"MPIFMER","IN",I)=HLNODE
68 ;; ^XTMP($J,"MPIFMER","IN",I look for data
69 ;S CNT=0
70 ;F S CNT=$O(^XTMP($J,"MPIFMER","IN",CNT)) Q:CNT="" D
71 ;.S NODE=$G(^XTMP($J,"MPIFMER","IN",CNT))
72 ;.I $E(NODE,1,3)="MSH" S SEP=$E(NODE,4),SENDER=$P(NODE,SEP,4) Q:'$D(SEP)
73 ;.I $P(NODE,SEP)="EVN" Q:$P(NODE,SEP,2)'="A30"
74 ;.I $P(NODE,SEP)="PID" S NEWICN=+$P(NODE,SEP,3),CHK=$P($P(NODE,SEP,3),"V",2) Q:NEWICN=""
75 ;.I $P(NODE,SEP)="MRG" S OLDICN=+$P(NODE,SEP,2) Q:OLDICN=""
76 ;;
77 ;Q:'$D(OLDICN)
78 ;Q:'$D(^DPT("AICN",OLDICN))
79 ;; ^ old icn not at site
80 ;S PDFN=""
81 ;F S PDFN=$O(^DPT("AICN",OLDICN,PDFN)) Q:PDFN="" D
82 ;.; incase have multiple OLD-ICNs
83 ;.S CMOR=$$PAT^MPIFNQ(PDFN)
84 ;.I CMOR'=SENDER S ERR="MERGE ICN MESSAGE DID NOT COME FROM CMOR for Patient dfn="_PDFN D EXC^MPIFDEL(PDFN,ERR,226) Q
85 ;.K DA,DIE,DR
86 ;.S DA=PDFN,DIE="^DPT(",DR="991.01////"_NEWICN_";991.02////"_CHK,MPIFMER=""
87 ;.D ^DIE K MPIFMER
88 ;Q
Note: See TracBrowser for help on using the repository browser.