- 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 Feb 18, 2025@23:09:14 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)