RGRSDYN2 ;ALB/RJS-BUILD DYNAMIC LINK LIST FOR SENSITIVITY ;3-21-97 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**8**;30 Apr 99 EN(CLIENT,CLASS) ; ;CLIENT=HL7 CLIENT PROTOCOL AT TARGET SYSTEM ;DATA CLASS (Opt.) = Pull from Subs. Registry ONLY ;For now, anything else is both DESCRIPTIVE AND CLINICAL S CLASS=$G(CLASS),CLIENT=$G(CLIENT) Q:CLIENT="" ;No receiver N PPF,DFN,HERE,RGRS,PPFIEN PARS ;Parse local outbound message N RGDC D INITIZE^RGRSUTIL,EN^RGRSPARS("RGRS") ;Get patients owner site S PPF=$G(RGRS("SITENUM"))\1 Q:PPF'>0 S PPFIEN=$$LKUP^XUAF4(PPF) ;Get DFN S DFN=$G(RGRS("DFN")) Q:$G(DFN)']"" Q:$$IFLOCAL^MPIF001(DFN) ;Where we're at S HERE=$P($$SITE^VASITE,"^",3)\1 NOTPPF ; if not ppf send only to ppf I PPF'=HERE D Q . N PPFLINK,INDEX . D LINK^HLUTIL3(PPFIEN,.PPFLINK) . S INDEX=$O(PPFLINK(0)) . I INDEX]"" S HLL("LINKS",1)=CLIENT_"^"_PPFLINK(INDEX) ISPPF ; I PPF=HERE D Q . N PARENT,INDEX,SUBCONTL,CHILDREN,INDEX1,NODE . S NODE=$$MPINODE^MPIFAPI(DFN) . S SUBCONTL=$P($G(NODE),"^",5) . ;Get subscribers, return updated HLL array . I SUBCONTL]"" D GET^HLSUB(SUBCONTL,+CLASS,CLIENT,.HLL) . ;LAST MINUTE CHANGE MARILYN REQUESTED, COMMENTED OUT HERE . ;BECAUSE WE'RE NOT SURE THE MPI WANTS Z12'S . ;S MPI=$$MPILINK^MPIFAPI() D . ;. I $P($G(MPI),U)'=-1 S HLL("LINKS",9999999999)=CLIENT_"^"_MPI . ;. I $P($G(MPI),U)=-1 D . ;. . N RGLOG,RGMTXT . ;. . D START^RGHLLOG(HLMTIEN,"","") . ;. . S RGMTXT="" . ;. . D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)"_RGMTXT) D STOP^RGHLLOG(0) ; ;the following was commented out because we're not updating all sites ;in the VISN anymore ; ;. ;Get owners PARENT ;. D PARENT^XUAF4("PARENT",PPF) ;. S INDEX="" ;. S INDEX=$O(PARENT("P",INDEX)) ;. Q:INDEX']"" ;. D LINK^HLUTIL3(INDEX,.CHILDREN) ;. S INDEX=$O(HLL("LINKS",9999999999999),-1) ;. Q:INDEX']"" ;. S INDEX1=0 ;. F S INDEX1=$O(CHILDREN(INDEX1)) Q:INDEX1'>0 D ;. . S INDEX=INDEX+1 ;. . S HLL("LINKS",INDEX)=CLIENT_"^"_CHILDREN(INDEX1)