95 lines
3.9 KiB
Mathematica
95 lines
3.9 KiB
Mathematica
|
RGJCSUB ;SF/JC-MPI/PD SUBSCRIPTION GENERATOR ;04/30/97
|
||
|
|
;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,19,27**;30 Apr 99
|
||
|
|
EQ(RGEV,RGSTUB,RGERR,RGEP) ;Entry point for Event Queue Processor
|
||
|
|
S FLL=$P(RGSTUB,U),TLL=$P(RGSTUB,U,2),ICN=$P(RGSTUB,U,3)
|
||
|
|
S PN=$P(RGSTUB,U,4),TP=$P(RGSTUB,U,5),AD=$P(RGSTUB,U,6)
|
||
|
|
S TD=$P(RGSTUB,U,7)
|
||
|
|
I FLL=""!(TLL="")!(ICN="")!(PN="")!(TP="") S RGERR="REQUIRED PARAMETERS MISSING IN STUB"
|
||
|
|
I AD="" S AD=$$NOW^XLFDT,AD=$$DTFH^RGHLUT(AD,1) ;activation date
|
||
|
|
D BM(FLL,TLL,ICN,PN,TP,AD,TD)
|
||
|
|
Q
|
||
|
|
BM(FLL,TLL,ICN,PN,TP,AD,TD) ;Build Subscription Request Message
|
||
|
|
;FLL-'FROM' LOGICAL LINK NAME
|
||
|
|
;TLL-'TO' LOGICAL LINK NAME
|
||
|
|
;ICN-PATIENT ID
|
||
|
|
;PN-PATIENT NAME
|
||
|
|
;TP-SUBSCRIPTION TYPE
|
||
|
|
;AD-ACTIVATION DATE HL7 FORMAT
|
||
|
|
;TD-TERMINATION DATE HL7 FORMAT-OPTIONAL
|
||
|
|
N RGCMOR,RGDFN,RGSSN
|
||
|
|
Q:'+ICN
|
||
|
|
S RGDFN=$$GETDFN^MPIF001(+ICN) Q:+RGDFN<1
|
||
|
|
S RGSSN=$P(^DPT(RGDFN,0),U,9)
|
||
|
|
;Get institution number of CMOR
|
||
|
|
S RGCMOR=$$GETVCCI^MPIF001(RGDFN)
|
||
|
|
N RGCS,RGRC,RGEC,RGSS,HL
|
||
|
|
D INIT^HLFNC2("RG PT SUBSCRIPTION REQUEST",.HL) Q:+$G(HL)
|
||
|
|
S HLL("LINKS",1)="RG PT SUBSCRIPTION RECEIVER^"_TLL
|
||
|
|
S RGCS=$E(HL("ECH"),1) ;Component
|
||
|
|
S RGRC=$E(HL("ECH"),2) ;Repitition
|
||
|
|
S RGEC=$E(HL("ECH"),3) ;Escape
|
||
|
|
S RGSS=$E(HL("ECH"),4) ;Sub-component separator
|
||
|
|
MFI ;MFI-master file identifier segment
|
||
|
|
N X,HLA S X=""
|
||
|
|
S $P(X,HL("FS"))="MFI"
|
||
|
|
S $P(X,HL("FS"),2)="774"_RGCS_"SUBSCRIPTION REGISTRY"_RGCS_"L"
|
||
|
|
S $P(X,HL("FS"),4)="UPD"
|
||
|
|
S $P(X,HL("FS"),7)="NE"
|
||
|
|
S HLA("HLS",1)=X
|
||
|
|
MFE ;MFE-master file entry segment
|
||
|
|
S X=""
|
||
|
|
S $P(X,HL("FS"))="MFE"
|
||
|
|
S $P(X,HL("FS"),2)="MUP",$P(X,HL("FS"),4)=AD
|
||
|
|
S $P(X,HL("FS"),5)=+ICN_RGSS_RGSSN_RGSS_2_RGCS_PN_RGCS_"L"
|
||
|
|
S HLA("HLS",2)=X
|
||
|
|
DATA ;Record level data in 'ZSD' SEGMENT
|
||
|
|
S HLA("HLS",3)="ZSD"_HL("FS")_FLL_HL("FS")_TP_HL("FS")_AD_HL("FS")_$G(TD)_HL("FS")_HL("FS")_RGCMOR
|
||
|
|
SEND ;SEND TO HL7 PACKAGE
|
||
|
|
N HLRST
|
||
|
|
D GENERATE^HLMA("RG PT SUBSCRIPTION REQUEST","LM",1,.HLRST,"",.HL)
|
||
|
|
Q
|
||
|
|
ROUTE ;routing logic-parse A04 and put new message on event queue
|
||
|
|
;to primary facility
|
||
|
|
;If triggered by an A04
|
||
|
|
;I $G(HL("ETN"))'="A04" Q
|
||
|
|
;WITH NEW MESSAGING SUBSCRIPTIONS ARE NO LONGER USED
|
||
|
|
Q
|
||
|
|
K RGLL D R1
|
||
|
|
K RGVCCI,RGVCCIN,RGVCCIS
|
||
|
|
Q
|
||
|
|
R1 ;A04
|
||
|
|
N RGI,RGFS,RGLOC,RGLOCIEN,RGLOCNM,RGLOCSN,RGPN,RGSN,RGS,RGSCN,RGTP,RGTO
|
||
|
|
S RGS="",RGFS=HL("FS")
|
||
|
|
F RGI=1:1 X HLNEXT Q:HLQUIT'>0 Q:$P(HLNODE,HL("FS"))="PID"
|
||
|
|
Q:HLQUIT'>0
|
||
|
|
S RGICN=+$P(HLNODE,HL("FS"),3)
|
||
|
|
Q:'RGICN
|
||
|
|
S RGDFN=+$$GETDFN^MPIF001(RGICN)
|
||
|
|
Q:RGDFN'>0
|
||
|
|
S RGVCCI=$$GETVCCI^MPIF001(RGDFN)
|
||
|
|
Q:RGVCCI<1
|
||
|
|
;fix TS need IEN for compare not sta. num.
|
||
|
|
S RGVCCI=$$LKUP^XUAF4(RGVCCI)
|
||
|
|
I RGVCCI="" D START^RGHLLOG(HLMTIEN),EXC^RGHLLOG(229,"MSG#"_$G(HLMID)_" Unable to send Subscription. Duplicate station number of "_$$GETVCCI^MPIF001(RGDFN)_" in Institution file.",RGDFN) D STOP^RGHLLOG() Q
|
||
|
|
S RGPN=$P(^DPT(RGDFN,0),U) Q:RGPN=""
|
||
|
|
S RGTP=1 ;clinical update
|
||
|
|
S RGAD=$$NOW^XLFDT,RGAD=$$DTFH^RGHLUT(RGAD,1) ;activation date
|
||
|
|
;Local Station information
|
||
|
|
S RGLOC=$$SITE^VASITE(),RGLOCIEN=$P(RGLOC,U,1),RGLOCNM=$P(RGLOC,U,2),RGLOCSN=$P(RGLOC,U,3)
|
||
|
|
I RGVCCI=RGLOCIEN D ;current site is owner site, update existing subscribers
|
||
|
|
.S RGSCN=$$GETSCN^RGJCREC(RGDFN) ;get SCN
|
||
|
|
.D LINK^HLUTIL3(RGLOCIEN,.RGFROM) ;get local link definition
|
||
|
|
.S RGLL=$O(RGFROM(0)) Q:RGLL="" S RGLL=RGFROM(RGLL)
|
||
|
|
.D REC1^RGJCREC
|
||
|
|
I RGVCCI'=RGLOCIEN D ;current site is not owner, update only owner
|
||
|
|
.D LINK^HLUTIL3(RGLOCIEN,.RGFROM) ;Local Link
|
||
|
|
.S RGFROM=$O(RGFROM(0)) Q:RGFROM="" S RGFROM=RGFROM(RGFROM) ;sending facility
|
||
|
|
.I $E(RGFROM,1,2)'="VA" D START^RGHLLOG(HLMTIEN),EXC^RGHLLOG(224,"MSG#"_$G(HLMID)_" Unable to send Subscription from "_RGFROM_". This is not a MPI/PD Site.",RGDFN) D STOP^RGHLLOG() Q
|
||
|
|
.D LINK^HLUTIL3(RGVCCI,.RGTO) ;get VCCI Link
|
||
|
|
.S RGTO=$O(RGTO(0)) Q:RGTO=""
|
||
|
|
.S RGTO=RGTO(RGTO) ;receiving facility
|
||
|
|
.I $E(RGTO,1,2)'="VA" D START^RGHLLOG(HLMTIEN),EXC^RGHLLOG(224,"MSG#"_$G(HLMID)_" Unable to send Subscription to "_RGTO_". This is not a MPI/PD Site.",RGDFN) D STOP^RGHLLOG() Q
|
||
|
|
.Q:RGTO=RGFROM
|
||
|
|
.S RGSTUB=RGFROM_U_RGTO_U_RGICN_U_RGPN_U_RGTP_U_RGAD
|
||
|
|
.D EN^RGEQ("SCN_REQ",RGSTUB)
|