source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGJCTS01.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1RGJCTS01 ;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
4INSERT(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
Note: See TracBrowser for help on using the repository browser.