RGRSDYN2.m

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 ---RGRSDYN2   2072     printed  Apr 09, 2024@20:47:40                                                                                                                                                                                                    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)