131 lines
6.0 KiB
Mathematica
131 lines
6.0 KiB
Mathematica
RGJCREC ;SF/JC,LTL-MPI/PD SUBSCRIPTION PROCESSOR ;05/12/98
|
|
;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,8,19**;30 Apr 99
|
|
;
|
|
;Reference to $$UPDATE^MPIFAPI supported by IA #2706
|
|
;Reference to $$SEND2^VAFCUTL1 supported by IA #2779
|
|
;Reference to ^DPT( supported by IA #2969
|
|
;
|
|
REC ;Receive inbound MPI/PD Subscription request
|
|
;Read in message for file 774 Master File Update
|
|
;
|
|
Q:($G(HL("MTN"))'="MFN")!($G(HL("ETN"))'="Z15") ;only process MPI/PD MFN/Z15 messages
|
|
K RGS,RGSEG,RGFS,RGCS,RGEC,RGSS,RGFILE,RGACT,RGCD,RGID,RGICN,RGSSN,RGPN,RGLL,RGTP,RGAD,RGTD,RGRAP,RGCMOR,RGDFN,RGPPFI,RGSCN,RGCURI,RGFROM,RGTO,RGSTUB,RGAD1,RGL,RGRC,HLER
|
|
N RGLOG,RGMTXT,X D START^RGHLLOG(HLMTIEN,"SCN_REQ","")
|
|
;
|
|
S RGS="",U="^" N J
|
|
S RGFS=HL("FS") ;Field
|
|
S RGCS=$E(HL("ECH"),1) ;Component
|
|
S RGRC=$E(HL("ECH"),2) ;Repetition
|
|
S RGEC=$E(HL("ECH"),3) ;Escape
|
|
S RGSS=$E(HL("ECH"),4) ;Sub-component separator
|
|
F RGI=1:1 X HLNEXT Q:HLQUIT'>0 S (RGSEG,RGS(RGI))=HLNODE D
|
|
.S J=0 F S J=$O(HLNODE(J)) Q:'J S RGS(RGI,J)=HLNODE(J)
|
|
.D PARS
|
|
;K RGLL ;TS 3-27-98
|
|
;D PARS add this to hl7 processing logic above
|
|
I $D(RGFILE) Q:RGFILE'=774
|
|
;Pt DFN
|
|
S RGDFN=$$GETDFN^MPIF001(+RGICN)
|
|
I +$$SEND2^VAFCUTL1(RGDFN,"T") D CLEAN Q ;don't process test patients
|
|
;Validate DFN/ICN/SSN on receiving system
|
|
I RGDFN'>0 D D CLEAN Q
|
|
. S RGMTXT=""
|
|
. D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" Bad DFN, "_$G(RGDFN)_", for "_$G(RGPN)_" (ICN#"_$G(RGICN)_")"_RGMTXT,RGDFN) D STOP^RGHLLOG(1) Q
|
|
I $P(^DPT(RGDFN,0),U,9)'=RGSSN D D CLEAN Q
|
|
. S RGMTXT=" See the Exception Handling document on the MPI/PD web site."
|
|
. D EXC^RGHLLOG(213,"Msg#"_$G(HL("MID"))_" Mismatched SSN,"_$P(^DPT(RGDFN,0),U,9)_"/"_$G(RGSSN)_" for "_$G(RGPN)_" (ICN#"_$G(RGICN)_")"_RGMTXT,RGDFN) D STOP^RGHLLOG(1) Q
|
|
;Pt CMOR/Subscription Control Number
|
|
S RGPPFI=$$GETVCCI^MPIF001(RGDFN)
|
|
I +RGPPFI<1 D D CLEAN Q
|
|
. S RGMTXT=""
|
|
. D EXC^RGHLLOG(211,"Msg#"_$G(HL("MID"))_" Bad CMOR "_$G(RGPPFI)_" for DFN#"_$G(RGDFN)_RGMTXT,RGDFN) D STOP^RGHLLOG(1) Q
|
|
;Verify that sender and receiver agree on CMOR
|
|
I RGCMOR'=RGPPFI D D CLEAN Q
|
|
. S RGMTXT=""
|
|
. D EXC^RGHLLOG(211,"Msg#"_$G(HL("MID"))_" Mismatched CMOR, "_$G(RGCMOR)_"/"_$G(RGPPFI)_" for "_$G(RGPN)_" (ICN#"_$G(RGICN)_")"_RGMTXT,RGDFN) D STOP^RGHLLOG(1) Q
|
|
S RGSCN=$$GETSCN(RGDFN)
|
|
I RGSCN="" D D CLEAN Q
|
|
. S RGMTXT=""
|
|
. D EXC^RGHLLOG(228,"Msg#"_$G(HL("MPI"))_" "_$G(RGPN)_" Does not exist in patient database. "_RGMTXT,RGDFN) D STOP^RGHLLOG(1) Q
|
|
;Current Site ien
|
|
S RGCURI=+$$SITE^VASITE()
|
|
;If not CMOR, don't update anyone else
|
|
I $$IFVCCI^MPIF001(RGDFN)'=1 D FIL K RGLL Q ;TS 3-27-98
|
|
;If filing data at owner site, que update to CLINICAL SUBSCRIBERS
|
|
D REC1
|
|
;Add new clinical subscriber to local registry
|
|
D FIL
|
|
D REC2
|
|
CLEAN K RGSTUB,RGLL ;TS 3-27-98
|
|
D STOP^RGHLLOG(0)
|
|
K RGS,RGSEG,RGFS,RGCS,RGEC,RGSS,RGFILE,RGACT,RGCD,RGID,RGICN,RGSSN,RGPN,RGLL,RGTP,RGAD,RGTD,RGRAP,RGCMOR,RGDFN,RGPPFI,RGSCN,RGCURI,RGFROM,RGTO,RGSTUB,RGAD1,RGL,RGRC,RGI
|
|
Q
|
|
REC1 ;Update clinical subscribers with newest one
|
|
D GET^RGRSDYN1(RGDFN,RGSCN,0,"",.RGLL)
|
|
N I S I=0 F S I=$O(RGLL("LINKS",I)) Q:I<1 D
|
|
.S RGFROM=RGLL ;New Subscriber
|
|
.I $E(RGFROM,1,2)'="VA" D START^RGHLLOG(HLMTIEN,"SCN_REQ","") D EXC^RGHLLOG(224,"MSG#"_$G(HL("MID"))_" Unable to send Subscription Request from "_RGFROM_". This is not a MPI/PD site.",RGDFN) D CLEAN Q
|
|
.S RGTO=$P(RGLL("LINKS",I),U,2) ;Destination (Clinical Subscriber)
|
|
.I $E(RGTO,1,2)'="VA" D START^RGHLLOG(HLMTIEN,"SCN_REQ","") D EXC^RGHLLOG(224,"MSG#"_$G(HL("MID"))_" Unable to send Subscription Request to "_RGTO_". This is not a MPI/PD site.",RGDFN) D CLEAN Q
|
|
.S RGSTUB=RGFROM_U_RGTO_U_RGICN_U_RGPN_U_RGTP_U_RGAD_U_$G(RGTD)
|
|
.D:RGFROM'=RGTO EN^RGEQ("SCN_REQ",RGSTUB) ;put on Event Queue
|
|
Q
|
|
REC2 ;Update newest subscriber with previous subscribers and CMOR
|
|
;change 4/10/98 CMC to get links
|
|
K RGLL("LINKS")
|
|
D GET^RGRSDYN1(RGDFN,RGSCN,0,"",.RGLL)
|
|
S I=0 F S I=$O(RGLL("LINKS",I)) Q:I<1 D
|
|
.S RGTO=RGLL
|
|
.I $E(RGTO,1,2)'="VA" D START^RGHLLOG(HLMTIEN,"SCN_REQ","") D EXC^RGHLLOG(224,"MSG#"_$G(HL("MID"))_" Unable to send Subscription Request to "_RGTO_". This is not a MPI/PD site.",RGDFN) D CLEAN Q
|
|
.S RGFROM=$P(RGLL("LINKS",I),U,2)
|
|
.I $E(RGFROM,1,2)'="VA" D START^RGHLLOG(HLMTIEN,"SCN_REQ","") D EXC^RGHLLOG(224,"MSG#"_$G(HL("MID"))_" Unable to send Subscription Request from "_RGFROM_". This is not a MPI/PD site.",RGDFN) D CLEAN Q
|
|
.S RGSTUB=RGFROM_U_RGTO_U_RGICN_U_RGPN_U_RGTP_U_RGAD_U_$G(RGTD)
|
|
.I RGTO'=RGFROM D EN^RGEQ("SCN_REQ",RGSTUB)
|
|
;Now send current institution (CMOR)
|
|
K RGL
|
|
D LINK^HLUTIL3(RGCURI,.RGL) S RGL=$O(RGL(0)) Q:RGL<1
|
|
;changed cmc 5/9/98
|
|
S RGSTUB=RGL(RGL)_U_RGLL_U_RGICN_U_RGPN_U_RGTP_U_RGAD_U_$G(RGTD)
|
|
D:RGL(RGL)'=RGLL EN^RGEQ("SCN_REQ",RGSTUB)
|
|
K RGSTUB
|
|
Q
|
|
PARS ;Parse it
|
|
I $E(RGSEG,1,3)="MFI" D
|
|
.S RGFILE=+$P(RGSEG,RGFS,2) ;File number
|
|
I $E(RGSEG,1,3)="MFE" D
|
|
.S RGACT=$P(RGSEG,RGFS,2) ;Action
|
|
.S RGCD=$P(RGSEG,RGFS,4) ;creation date
|
|
.S RGID=$P(RGSEG,RGFS,5) D ;Primary Key
|
|
..S RGICN=+RGID,RGSSN=$P(RGID,RGSS,2),RGPN=$P(RGID,RGCS,2) ;ICN,Patient Name
|
|
I $E(RGSEG,1,3)="ZSD" D
|
|
.S RGLL=$P(RGSEG,RGFS,2) ;Link
|
|
.S RGTP=$P(RGSEG,RGFS,3) ;Type
|
|
.S RGAD=$P(RGSEG,RGFS,4) ;Activation Date
|
|
.S RGTD=$P(RGSEG,RGFS,5) ;Termination Date
|
|
.S RGRAP=$P(RGSEG,RGFS,6) ;Receiving Application
|
|
.S RGCMOR=$P(RGSEG,RGFS,7) ;Coordinating Master of Record
|
|
Q
|
|
GETSCN(RGDPT) ;Return existing SCN or Activate a new subscription for this patient
|
|
;RGDPT=PATIENT DFN
|
|
N RGAR,RGAN
|
|
;get subscription control #
|
|
S RGSCN=+$P($$MPINODE^MPIFAPI(RGDPT),"^",5)
|
|
;if no SCN, create new and update 991.05, then return result
|
|
I 'RGSCN S RGSCN=$$ACT^HLSUB S RGAR(991.05)=RGSCN S RGAN=$$UPDATE^MPIFAPI(RGDPT,"RGAR") I RGAN=-1 S RGSCN=""
|
|
Q RGSCN
|
|
FIL ;File message
|
|
;Normalize dates
|
|
N RGCHK,RGTD1
|
|
S RGAD1=$$DTHF^RGHLUT(RGAD)
|
|
I $G(RGTD)]"" S RGTD1=$$DTHF^RGHLUT(RGTD)
|
|
;check to see if this subscriber is yourself
|
|
D LINK^HLUTIL3(+$$SITE^VASITE,.RGCHK) Q:$O(RGCHK(0))="" S RGCHK=RGCHK($O(RGCHK(0)))
|
|
I $G(RGCHK)'=RGLL D UPD^HLSUB(RGSCN,RGLL,RGTP,RGAD1,$G(RGTD1),$G(RGRAP),.HLER)
|
|
Q
|
|
GETINST(LINK) ;returns institution ien from logical link
|
|
N DIC,X,Y
|
|
I $G(LINK)="" Q 0
|
|
S DIC=870,DIC(0)="EMQZ",X=LINK D ^DIC
|
|
I Y=-1 Q Y
|
|
Q $P(Y(0),"^",2)
|