| 1 | RGRSDYN2 ;ALB/RJS-BUILD DYNAMIC LINK LIST FOR SENSITIVITY ;3-21-97
|
|---|
| 2 | ;;1.0;CLINICAL INFO RESOURCE NETWORK;**8**;30 Apr 99
|
|---|
| 3 | EN(CLIENT,CLASS) ;
|
|---|
| 4 | ;CLIENT=HL7 CLIENT PROTOCOL AT TARGET SYSTEM
|
|---|
| 5 | ;DATA CLASS (Opt.) = Pull from Subs. Registry ONLY
|
|---|
| 6 | ;For now, anything else is both DESCRIPTIVE AND CLINICAL
|
|---|
| 7 | S CLASS=$G(CLASS),CLIENT=$G(CLIENT)
|
|---|
| 8 | Q:CLIENT="" ;No receiver
|
|---|
| 9 | N PPF,DFN,HERE,RGRS,PPFIEN
|
|---|
| 10 | PARS ;Parse local outbound message
|
|---|
| 11 | N RGDC
|
|---|
| 12 | D INITIZE^RGRSUTIL,EN^RGRSPARS("RGRS")
|
|---|
| 13 | ;Get patients owner site
|
|---|
| 14 | S PPF=$G(RGRS("SITENUM"))\1 Q:PPF'>0
|
|---|
| 15 | S PPFIEN=$$LKUP^XUAF4(PPF)
|
|---|
| 16 | ;Get DFN
|
|---|
| 17 | S DFN=$G(RGRS("DFN")) Q:$G(DFN)']""
|
|---|
| 18 | Q:$$IFLOCAL^MPIF001(DFN)
|
|---|
| 19 | ;Where we're at
|
|---|
| 20 | S HERE=$P($$SITE^VASITE,"^",3)\1
|
|---|
| 21 | NOTPPF ; if not ppf send only to ppf
|
|---|
| 22 | I PPF'=HERE D Q
|
|---|
| 23 | . N PPFLINK,INDEX
|
|---|
| 24 | . D LINK^HLUTIL3(PPFIEN,.PPFLINK)
|
|---|
| 25 | . S INDEX=$O(PPFLINK(0))
|
|---|
| 26 | . I INDEX]"" S HLL("LINKS",1)=CLIENT_"^"_PPFLINK(INDEX)
|
|---|
| 27 | ISPPF ;
|
|---|
| 28 | I PPF=HERE D Q
|
|---|
| 29 | . N PARENT,INDEX,SUBCONTL,CHILDREN,INDEX1,NODE
|
|---|
| 30 | . S NODE=$$MPINODE^MPIFAPI(DFN)
|
|---|
| 31 | . S SUBCONTL=$P($G(NODE),"^",5)
|
|---|
| 32 | . ;Get subscribers, return updated HLL array
|
|---|
| 33 | . I SUBCONTL]"" D GET^HLSUB(SUBCONTL,+CLASS,CLIENT,.HLL)
|
|---|
| 34 | . ;LAST MINUTE CHANGE MARILYN REQUESTED, COMMENTED OUT HERE
|
|---|
| 35 | . ;BECAUSE WE'RE NOT SURE THE MPI WANTS Z12'S
|
|---|
| 36 | . ;S MPI=$$MPILINK^MPIFAPI() D
|
|---|
| 37 | . ;. I $P($G(MPI),U)'=-1 S HLL("LINKS",9999999999)=CLIENT_"^"_MPI
|
|---|
| 38 | . ;. I $P($G(MPI),U)=-1 D
|
|---|
| 39 | . ;. . N RGLOG,RGMTXT
|
|---|
| 40 | . ;. . D START^RGHLLOG(HLMTIEN,"","")
|
|---|
| 41 | . ;. . S RGMTXT=""
|
|---|
| 42 | . ;. . D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)"_RGMTXT) D STOP^RGHLLOG(0)
|
|---|
| 43 | ;
|
|---|
| 44 | ;the following was commented out because we're not updating all sites
|
|---|
| 45 | ;in the VISN anymore
|
|---|
| 46 | ;
|
|---|
| 47 | ;. ;Get owners PARENT
|
|---|
| 48 | ;. D PARENT^XUAF4("PARENT",PPF)
|
|---|
| 49 | ;. S INDEX=""
|
|---|
| 50 | ;. S INDEX=$O(PARENT("P",INDEX))
|
|---|
| 51 | ;. Q:INDEX']""
|
|---|
| 52 | ;. D LINK^HLUTIL3(INDEX,.CHILDREN)
|
|---|
| 53 | ;. S INDEX=$O(HLL("LINKS",9999999999999),-1)
|
|---|
| 54 | ;. Q:INDEX']""
|
|---|
| 55 | ;. S INDEX1=0
|
|---|
| 56 | ;. F S INDEX1=$O(CHILDREN(INDEX1)) Q:INDEX1'>0 D
|
|---|
| 57 | ;. . S INDEX=INDEX+1
|
|---|
| 58 | ;. . S HLL("LINKS",INDEX)=CLIENT_"^"_CHILDREN(INDEX1)
|
|---|
