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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGRSDYN2 2072 printed Nov 22, 2024@16:53:05 Page 2
RGRSDYN2 ;ALB/RJS-BUILD DYNAMIC LINK LIST FOR SENSITIVITY ;3-21-97
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**8**;30 Apr 99
EN(CLIENT,CLASS) ;
+1 ;CLIENT=HL7 CLIENT PROTOCOL AT TARGET SYSTEM
+2 ;DATA CLASS (Opt.) = Pull from Subs. Registry ONLY
+3 ;For now, anything else is both DESCRIPTIVE AND CLINICAL
+4 SET CLASS=$GET(CLASS)
SET CLIENT=$GET(CLIENT)
+5 ;No receiver
if CLIENT=""
QUIT
+6 NEW PPF,DFN,HERE,RGRS,PPFIEN
PARS ;Parse local outbound message
+1 NEW RGDC
+2 DO INITIZE^RGRSUTIL
DO EN^RGRSPARS("RGRS")
+3 ;Get patients owner site
+4 SET PPF=$GET(RGRS("SITENUM"))\1
if PPF'>0
QUIT
+5 SET PPFIEN=$$LKUP^XUAF4(PPF)
+6 ;Get DFN
+7 SET DFN=$GET(RGRS("DFN"))
if $GET(DFN)']""
QUIT
+8 if $$IFLOCAL^MPIF001(DFN)
QUIT
+9 ;Where we're at
+10 SET HERE=$PIECE($$SITE^VASITE,"^",3)\1
NOTPPF ; if not ppf send only to ppf
+1 IF PPF'=HERE
Begin DoDot:1
+2 NEW PPFLINK,INDEX
+3 DO LINK^HLUTIL3(PPFIEN,.PPFLINK)
+4 SET INDEX=$ORDER(PPFLINK(0))
+5 IF INDEX]""
SET HLL("LINKS",1)=CLIENT_"^"_PPFLINK(INDEX)
End DoDot:1
QUIT
ISPPF ;
+1 IF PPF=HERE
Begin DoDot:1
+2 NEW PARENT,INDEX,SUBCONTL,CHILDREN,INDEX1,NODE
+3 SET NODE=$$MPINODE^MPIFAPI(DFN)
+4 SET SUBCONTL=$PIECE($GET(NODE),"^",5)
+5 ;Get subscribers, return updated HLL array
+6 IF SUBCONTL]""
DO GET^HLSUB(SUBCONTL,+CLASS,CLIENT,.HLL)
+7 ;LAST MINUTE CHANGE MARILYN REQUESTED, COMMENTED OUT HERE
+8 ;BECAUSE WE'RE NOT SURE THE MPI WANTS Z12'S
+9 ;S MPI=$$MPILINK^MPIFAPI() D
+10 ;. I $P($G(MPI),U)'=-1 S HLL("LINKS",9999999999)=CLIENT_"^"_MPI
+11 ;. I $P($G(MPI),U)=-1 D
+12 ;. . N RGLOG,RGMTXT
+13 ;. . D START^RGHLLOG(HLMTIEN,"","")
+14 ;. . S RGMTXT=""
+15 ;. . D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)"_RGMTXT) D STOP^RGHLLOG(0)
End DoDot:1
QUIT
+16 ;
+17 ;the following was commented out because we're not updating all sites
+18 ;in the VISN anymore
+19 ;
+20 ;. ;Get owners PARENT
+21 ;. D PARENT^XUAF4("PARENT",PPF)
+22 ;. S INDEX=""
+23 ;. S INDEX=$O(PARENT("P",INDEX))
+24 ;. Q:INDEX']""
+25 ;. D LINK^HLUTIL3(INDEX,.CHILDREN)
+26 ;. S INDEX=$O(HLL("LINKS",9999999999999),-1)
+27 ;. Q:INDEX']""
+28 ;. S INDEX1=0
+29 ;. F S INDEX1=$O(CHILDREN(INDEX1)) Q:INDEX1'>0 D
+30 ;. . S INDEX=INDEX+1
+31 ;. . S HLL("LINKS",INDEX)=CLIENT_"^"_CHILDREN(INDEX1)
