RGJCTS01.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RGJCTS01   1422     printed  Mar 13, 2025@20:46:43                                                                                                                                                                                                    Page 2

RGJCTS01  ;SLC/TS-SUBSCRIPTION CONTROL STARTUP UTILITY TO CMOR ;09/18/97

 +1       ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,19**;30 Apr 99

 +2       ;IMPROVED FOR CMOR COMMUNICATION TS

INSERT(ZZHLDPT) ; pass dfn

 +1        SET ZZRGEV="SCN_REQ"

 +2        KILL ZZFMLK,ZZTOLK

 +3       ;setup for event stub

 +4       ;who are we

           SET ZZHLINST=+$$KSP^XUPARAM("INST")

 +5        DO LINK^HLUTIL3(ZZHLINST,.ZZFMLK)

           SET ZZFMLK=$ORDER(ZZFMLK(0))

           if ZZFMLK<1

               QUIT 

 +6        SET $PIECE(ZZSTUB,U,1)=ZZFMLK(ZZFMLK)

 +7        IF $EXTRACT($PIECE(ZZSTUB,U,1),1,2)'="VA"

               Begin DoDot:1

 +8                DO START^RGHLLOG($GET(HLMTIEN),"SCN_REQ","")

                   DO EXC^RGHLLOG(224,"MSG#"_$GET(HL("MID"))_" Unable to send Subscription Request from, "_$PIECE($GET(ZZSTUB),U,1)_".  This is not a MPI/PD site.",ZZHLDPT)

                   DO STOP^RGHLLOG(1)

                   QUIT 

               End DoDot:1

 +9       ;who owns him

           SET ZZTOST=$$GETVCCI^MPIF001(ZZHLDPT)

 +10      ;fix TS change to IEN

 +11       SET ZZTOST=$$LKUP^XUAF4(ZZTOST)

 +12       DO LINK^HLUTIL3(ZZTOST,.ZZTOLK)

           SET ZZTOLK=$ORDER(ZZTOLK(0))

           if ZZTOLK<1

               QUIT 

 +13       SET $PIECE(ZZSTUB,U,2)=ZZTOLK(ZZTOLK)

 +14       IF $EXTRACT($PIECE(ZZSTUB,U,2),1,2)'="VA"

               Begin DoDot:1

 +15               DO START^RGHLLOG(HLMTIEN,"SCN_REQ","")

                   DO EXC^RGHLLOG(224,"MSG#"_$GET(HL("MID"))_" Unable to send Subscription Request to, "_$PIECE($GET(ZZSTUB),U,2)_".  This is not a MPI/PD site.",ZZHLDPT)

                   DO STOP^RGHLLOG(1)

                   QUIT 

               End DoDot:1

 +16       SET ZZRGICN=$$GETICN^MPIF001(ZZHLDPT)

 +17       SET $PIECE(ZZSTUB,U,3)=ZZRGICN

 +18       SET DIC="^DPT("

           SET DIC(0)="NZ"

           SET X=ZZHLDPT

           DO ^DIC

           if Y'>0

               QUIT 

           SET ZZPNM=$PIECE(Y,U,2)

 +19       SET $PIECE(ZZSTUB,U,4)=ZZPNM

 +20       SET $PIECE(ZZSTUB,U,5)=0

 +21       if ZZFMLK(ZZFMLK)=ZZTOLK(ZZTOLK)

               QUIT 

 +22       DO EN^RGEQ(ZZRGEV,ZZSTUB)

 +23       KILL ZZHLINST,ZZRGEV,ZZFMLK,ZZTOLK,ZZSTUB,ZZTOST,ZZRGICN,ZZPNM,X,Y,DIC

 +24       QUIT