| 1 | RGJCTS01 ;SLC/TS-SUBSCRIPTION CONTROL STARTUP UTILITY TO CMOR ;09/18/97
|
|---|
| 2 | ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19**;30 Apr 99
|
|---|
| 3 | ;IMPROVED FOR CMOR COMMUNICATION TS
|
|---|
| 4 | INSERT(ZZHLDPT) ; pass dfn
|
|---|
| 5 | S ZZRGEV="SCN_REQ"
|
|---|
| 6 | K ZZFMLK,ZZTOLK
|
|---|
| 7 | ;setup for event stub
|
|---|
| 8 | S ZZHLINST=+$$KSP^XUPARAM("INST") ;who are we
|
|---|
| 9 | D LINK^HLUTIL3(ZZHLINST,.ZZFMLK) S ZZFMLK=$O(ZZFMLK(0)) Q:ZZFMLK<1
|
|---|
| 10 | S $P(ZZSTUB,U,1)=ZZFMLK(ZZFMLK)
|
|---|
| 11 | I $E($P(ZZSTUB,U,1),1,2)'="VA" D
|
|---|
| 12 | . 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
|
|---|
| 13 | S ZZTOST=$$GETVCCI^MPIF001(ZZHLDPT) ;who owns him
|
|---|
| 14 | ;fix TS change to IEN
|
|---|
| 15 | S ZZTOST=$$LKUP^XUAF4(ZZTOST)
|
|---|
| 16 | D LINK^HLUTIL3(ZZTOST,.ZZTOLK) S ZZTOLK=$O(ZZTOLK(0)) Q:ZZTOLK<1
|
|---|
| 17 | S $P(ZZSTUB,U,2)=ZZTOLK(ZZTOLK)
|
|---|
| 18 | I $E($P(ZZSTUB,U,2),1,2)'="VA" D
|
|---|
| 19 | . 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
|
|---|
| 20 | S ZZRGICN=$$GETICN^MPIF001(ZZHLDPT)
|
|---|
| 21 | S $P(ZZSTUB,U,3)=ZZRGICN
|
|---|
| 22 | S DIC="^DPT(",DIC(0)="NZ",X=ZZHLDPT D ^DIC Q:Y'>0 S ZZPNM=$P(Y,U,2)
|
|---|
| 23 | S $P(ZZSTUB,U,4)=ZZPNM
|
|---|
| 24 | S $P(ZZSTUB,U,5)=0
|
|---|
| 25 | Q:ZZFMLK(ZZFMLK)=ZZTOLK(ZZTOLK)
|
|---|
| 26 | D EN^RGEQ(ZZRGEV,ZZSTUB)
|
|---|
| 27 | K ZZHLINST,ZZRGEV,ZZFMLK,ZZTOLK,ZZSTUB,ZZTOST,ZZRGICN,ZZPNM,X,Y,DIC
|
|---|
| 28 | Q
|
|---|
