29 lines
1.4 KiB
Mathematica
29 lines
1.4 KiB
Mathematica
RGJCTS01 ;SLC/TS-SUBSCRIPTION CONTROL STARTUP UTILITY TO CMOR ;09/18/97
|
|
;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19**;30 Apr 99
|
|
;IMPROVED FOR CMOR COMMUNICATION TS
|
|
INSERT(ZZHLDPT) ; pass dfn
|
|
S ZZRGEV="SCN_REQ"
|
|
K ZZFMLK,ZZTOLK
|
|
;setup for event stub
|
|
S ZZHLINST=+$$KSP^XUPARAM("INST") ;who are we
|
|
D LINK^HLUTIL3(ZZHLINST,.ZZFMLK) S ZZFMLK=$O(ZZFMLK(0)) Q:ZZFMLK<1
|
|
S $P(ZZSTUB,U,1)=ZZFMLK(ZZFMLK)
|
|
I $E($P(ZZSTUB,U,1),1,2)'="VA" D
|
|
. D START^RGHLLOG($G(HLMTIEN),"SCN_REQ",""),EXC^RGHLLOG(224,"MSG#"_$G(HL("MID"))_" Unable to send Subscription Request from, "_$P($G(ZZSTUB),U,1)_". This is not a MPI/PD site.",ZZHLDPT) D STOP^RGHLLOG(1) Q
|
|
S ZZTOST=$$GETVCCI^MPIF001(ZZHLDPT) ;who owns him
|
|
;fix TS change to IEN
|
|
S ZZTOST=$$LKUP^XUAF4(ZZTOST)
|
|
D LINK^HLUTIL3(ZZTOST,.ZZTOLK) S ZZTOLK=$O(ZZTOLK(0)) Q:ZZTOLK<1
|
|
S $P(ZZSTUB,U,2)=ZZTOLK(ZZTOLK)
|
|
I $E($P(ZZSTUB,U,2),1,2)'="VA" D
|
|
. D START^RGHLLOG(HLMTIEN,"SCN_REQ",""),EXC^RGHLLOG(224,"MSG#"_$G(HL("MID"))_" Unable to send Subscription Request to, "_$P($G(ZZSTUB),U,2)_". This is not a MPI/PD site.",ZZHLDPT) D STOP^RGHLLOG(1) Q
|
|
S ZZRGICN=$$GETICN^MPIF001(ZZHLDPT)
|
|
S $P(ZZSTUB,U,3)=ZZRGICN
|
|
S DIC="^DPT(",DIC(0)="NZ",X=ZZHLDPT D ^DIC Q:Y'>0 S ZZPNM=$P(Y,U,2)
|
|
S $P(ZZSTUB,U,4)=ZZPNM
|
|
S $P(ZZSTUB,U,5)=0
|
|
Q:ZZFMLK(ZZFMLK)=ZZTOLK(ZZTOLK)
|
|
D EN^RGEQ(ZZRGEV,ZZSTUB)
|
|
K ZZHLINST,ZZRGEV,ZZFMLK,ZZTOLK,ZZSTUB,ZZTOST,ZZRGICN,ZZPNM,X,Y,DIC
|
|
Q
|