RGRSDYN ;ALB/RJS-BUILD DYNAMIC LINK LIST FOR A PATIENT ;03/21/97
;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,8,17,23,26,27**;30 Apr 99
;
;Reference to $$SEND2^VAFCUTL1 supported by IA #2779
;
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,ICN,RGRS,PPFIEN
PARS ;Parse local outbound message
N RGDC
D INITIZE^RGRSUTIL,EN^RGRSPARS("RGRS")
;code to prevent both new and old messaging from being sent out until the old protocols are removed from VAFC ADT-A04/A08 SERVER
I $G(RGRS("SENDING SITE"))=$P($$SITE^VASITE,"^",3) Q
I $G(RGRS("SENDING SITE"))="" Q
;Get patients owner site
S PPF=$G(RGRS("SITENUM"))\1 Q:PPF'>0
S PPFIEN=$$LKUP^XUAF4(PPF)
;get ICN
S ICN=$G(RGRS(991.01)) Q:$G(ICN)']""
;Get DFN
S DFN=$$GETDFN^MPIF001(ICN) Q:$G(DFN)'>0
Q:+$$SEND2^VAFCUTL1(DFN,"T") ;quit if test patient
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
. ;D GET^RGRSDYN1(DFN,SUBCONTL,+CLASS,CLIENT,.HLL)
. D GETLINKS^RGRSDYN1(.HLL)
. ;LAST MINUTE CHANGE MARILYN REQUESTED
. ;Get MPI link from SITE PARAMETER (when non A01/A03 event, ADT
. ;message) part of the DG*5.3*261/RG*1.0*4 bundle gjc@2/4/99
. I '$$ADT0103() D
. . N MPI 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,$G(DFN))
. . . . 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)
;
ADT0103() ; check to see if this is an ADT message type with an
; event of A01 -or- A03. If true, do not broadcast the message
; to the MPI. Part of the DG*5.3*261/RG*1.0*4 bundle. gjc@2/4/99
S HL("MTN")=$G(HL("MTN")),HL("ETN")=$G(HL("ETN")) ; just in case
Q $S(HL("MTN")="ADT"&(HL("ETN")="A01"!(HL("ETN")="A03")):1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGRSDYN 2956 printed Apr 09, 2024@20:46:51 Page 2
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
+2 ;
+3 ;Reference to $$SEND2^VAFCUTL1 supported by IA #2779
+4 ;
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,ICN,RGRS,PPFIEN
PARS ;Parse local outbound message
+1 NEW RGDC
+2 DO INITIZE^RGRSUTIL
DO EN^RGRSPARS("RGRS")
+3 ;code to prevent both new and old messaging from being sent out until the old protocols are removed from VAFC ADT-A04/A08 SERVER
+4 IF $GET(RGRS("SENDING SITE"))=$PIECE($$SITE^VASITE,"^",3)
QUIT
+5 IF $GET(RGRS("SENDING SITE"))=""
QUIT
+6 ;Get patients owner site
+7 SET PPF=$GET(RGRS("SITENUM"))\1
if PPF'>0
QUIT
+8 SET PPFIEN=$$LKUP^XUAF4(PPF)
+9 ;get ICN
+10 SET ICN=$GET(RGRS(991.01))
if $GET(ICN)']""
QUIT
+11 ;Get DFN
+12 SET DFN=$$GETDFN^MPIF001(ICN)
if $GET(DFN)'>0
QUIT
+13 ;quit if test patient
if +$$SEND2^VAFCUTL1(DFN,"T")
QUIT
+14 if $$IFLOCAL^MPIF001(DFN)
QUIT
+15 ;Where we're at
+16 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 ;D GET^RGRSDYN1(DFN,SUBCONTL,+CLASS,CLIENT,.HLL)
+7 DO GETLINKS^RGRSDYN1(.HLL)
+8 ;LAST MINUTE CHANGE MARILYN REQUESTED
+9 ;Get MPI link from SITE PARAMETER (when non A01/A03 event, ADT
+10 ;message) part of the DG*5.3*261/RG*1.0*4 bundle gjc@2/4/99
+11 IF '$$ADT0103()
Begin DoDot:2
+12 NEW MPI
SET MPI=$$MPILINK^MPIFAPI()
Begin DoDot:3
+13 IF $PIECE($GET(MPI),U)'=-1
SET HLL("LINKS",9999999999)=CLIENT_"^"_MPI
+14 IF $PIECE($GET(MPI),U)=-1
Begin DoDot:4
+15 NEW RGLOG,RGMTXT
+16 DO START^RGHLLOG(HLMTIEN,"","")
+17 SET RGMTXT=""
+18 DO EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)"_RGMTXT,$GET(DFN))
+19 DO STOP^RGHLLOG(0)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+20 ;
+21 ;the following was commented out because we're not updating all sites
+22 ;in the VISN anymore
+23 ;
+24 ;. ;Get owners PARENT
+25 ;. D PARENT^XUAF4("PARENT",PPF)
+26 ;. S INDEX=""
+27 ;. S INDEX=$O(PARENT("P",INDEX))
+28 ;. Q:INDEX']""
+29 ;. D LINK^HLUTIL3(INDEX,.CHILDREN)
+30 ;. S INDEX=$O(HLL("LINKS",9999999999999),-1)
+31 ;. Q:INDEX']""
+32 ;. S INDEX1=0
+33 ;. F S INDEX1=$O(CHILDREN(INDEX1)) Q:INDEX1'>0 D
+34 ;. . S INDEX=INDEX+1
+35 ;. . S HLL("LINKS",INDEX)=CLIENT_"^"_CHILDREN(INDEX1)
+36 ;
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
+2 ; to the MPI. Part of the DG*5.3*261/RG*1.0*4 bundle. gjc@2/4/99
+3 ; just in case
SET HL("MTN")=$GET(HL("MTN"))
SET HL("ETN")=$GET(HL("ETN"))
+4 QUIT $SELECT(HL("MTN")="ADT"&(HL("ETN")="A01"!(HL("ETN")="A03")):1,1:0)
