Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RGRSDYN

RGRSDYN.m

Go to the documentation of this file.
  1. RGRSDYN ;ALB/RJS-BUILD DYNAMIC LINK LIST FOR A PATIENT ;03/21/97
  1. ;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,8,17,23,26,27**;30 Apr 99
  1. ;
  1. ;Reference to $$SEND2^VAFCUTL1 supported by IA #2779
  1. ;
  1. EN(CLIENT,CLASS) ;
  1. ;CLIENT=HL7 CLIENT PROTOCOL AT TARGET SYSTEM
  1. ;DATA CLASS (Opt.) = Pull from Subs. Registry ONLY
  1. ;For now, anything else is both DESCRIPTIVE AND CLINICAL
  1. S CLASS=$G(CLASS),CLIENT=$G(CLIENT)
  1. Q:CLIENT="" ;No receiver
  1. N PPF,DFN,HERE,ICN,RGRS,PPFIEN
  1. PARS ;Parse local outbound message
  1. N RGDC
  1. D INITIZE^RGRSUTIL,EN^RGRSPARS("RGRS")
  1. ;code to prevent both new and old messaging from being sent out until the old protocols are removed from VAFC ADT-A04/A08 SERVER
  1. I $G(RGRS("SENDING SITE"))=$P($$SITE^VASITE,"^",3) Q
  1. I $G(RGRS("SENDING SITE"))="" Q
  1. ;Get patients owner site
  1. S PPF=$G(RGRS("SITENUM"))\1 Q:PPF'>0
  1. S PPFIEN=$$LKUP^XUAF4(PPF)
  1. ;get ICN
  1. S ICN=$G(RGRS(991.01)) Q:$G(ICN)']""
  1. ;Get DFN
  1. S DFN=$$GETDFN^MPIF001(ICN) Q:$G(DFN)'>0
  1. Q:+$$SEND2^VAFCUTL1(DFN,"T") ;quit if test patient
  1. Q:$$IFLOCAL^MPIF001(DFN)
  1. ;Where we're at
  1. S HERE=$P($$SITE^VASITE,"^",3)\1
  1. NOTPPF ; if not ppf send only to ppf
  1. I PPF'=HERE D Q
  1. . N PPFLINK,INDEX
  1. . D LINK^HLUTIL3(PPFIEN,.PPFLINK)
  1. . S INDEX=$O(PPFLINK(0))
  1. . I INDEX]"" S HLL("LINKS",1)=CLIENT_"^"_PPFLINK(INDEX)
  1. ISPPF ;
  1. I PPF=HERE D Q
  1. . N PARENT,INDEX,SUBCONTL,CHILDREN,INDEX1,NODE
  1. . S NODE=$$MPINODE^MPIFAPI(DFN)
  1. . S SUBCONTL=$P($G(NODE),"^",5)
  1. . ;Get subscribers, return updated HLL array
  1. . ;D GET^RGRSDYN1(DFN,SUBCONTL,+CLASS,CLIENT,.HLL)
  1. . D GETLINKS^RGRSDYN1(.HLL)
  1. . ;LAST MINUTE CHANGE MARILYN REQUESTED
  1. . ;Get MPI link from SITE PARAMETER (when non A01/A03 event, ADT
  1. . ;message) part of the DG*5.3*261/RG*1.0*4 bundle gjc@2/4/99
  1. . I '$$ADT0103() D
  1. . . N MPI S MPI=$$MPILINK^MPIFAPI() D
  1. . . . I $P($G(MPI),U)'=-1 S HLL("LINKS",9999999999)=CLIENT_"^"_MPI
  1. . . . I $P($G(MPI),U)=-1 D
  1. . . . . N RGLOG,RGMTXT
  1. . . . . D START^RGHLLOG(HLMTIEN,"","")
  1. . . . . S RGMTXT=""
  1. . . . . D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)"_RGMTXT,$G(DFN))
  1. . . . . D STOP^RGHLLOG(0)
  1. ;
  1. ;the following was commented out because we're not updating all sites
  1. ;in the VISN anymore
  1. ;
  1. ;. ;Get owners PARENT
  1. ;. D PARENT^XUAF4("PARENT",PPF)
  1. ;. S INDEX=""
  1. ;. S INDEX=$O(PARENT("P",INDEX))
  1. ;. Q:INDEX']""
  1. ;. D LINK^HLUTIL3(INDEX,.CHILDREN)
  1. ;. S INDEX=$O(HLL("LINKS",9999999999999),-1)
  1. ;. Q:INDEX']""
  1. ;. S INDEX1=0
  1. ;. F S INDEX1=$O(CHILDREN(INDEX1)) Q:INDEX1'>0 D
  1. ;. . S INDEX=INDEX+1
  1. ;. . S HLL("LINKS",INDEX)=CLIENT_"^"_CHILDREN(INDEX1)
  1. ;
  1. ADT0103() ; check to see if this is an ADT message type with an
  1. ; event of A01 -or- A03. If true, do not broadcast the message
  1. ; to the MPI. Part of the DG*5.3*261/RG*1.0*4 bundle. gjc@2/4/99
  1. S HL("MTN")=$G(HL("MTN")),HL("ETN")=$G(HL("ETN")) ; just in case
  1. Q $S(HL("MTN")="ADT"&(HL("ETN")="A01"!(HL("ETN")="A03")):1,1:0)