| [613] | 1 | RGRSDYN ;ALB/RJS-BUILD DYNAMIC LINK LIST FOR A PATIENT ;03/21/97
|
|---|
| 2 | ;;1.0;CLINICAL INFO RESOURCE NETWORK;**4,8,17,23,26,27**;30 Apr 99
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to $$SEND2^VAFCUTL1 supported by IA #2779
|
|---|
| 5 | ;
|
|---|
| 6 | EN(CLIENT,CLASS) ;
|
|---|
| 7 | ;CLIENT=HL7 CLIENT PROTOCOL AT TARGET SYSTEM
|
|---|
| 8 | ;DATA CLASS (Opt.) = Pull from Subs. Registry ONLY
|
|---|
| 9 | ;For now, anything else is both DESCRIPTIVE AND CLINICAL
|
|---|
| 10 | S CLASS=$G(CLASS),CLIENT=$G(CLIENT)
|
|---|
| 11 | Q:CLIENT="" ;No receiver
|
|---|
| 12 | N PPF,DFN,HERE,ICN,RGRS,PPFIEN
|
|---|
| 13 | PARS ;Parse local outbound message
|
|---|
| 14 | N RGDC
|
|---|
| 15 | D INITIZE^RGRSUTIL,EN^RGRSPARS("RGRS")
|
|---|
| 16 | ;code to prevent both new and old messaging from being sent out until the old protocols are removed from VAFC ADT-A04/A08 SERVER
|
|---|
| 17 | I $G(RGRS("SENDING SITE"))=$P($$SITE^VASITE,"^",3) Q
|
|---|
| 18 | I $G(RGRS("SENDING SITE"))="" Q
|
|---|
| 19 | ;Get patients owner site
|
|---|
| 20 | S PPF=$G(RGRS("SITENUM"))\1 Q:PPF'>0
|
|---|
| 21 | S PPFIEN=$$LKUP^XUAF4(PPF)
|
|---|
| 22 | ;get ICN
|
|---|
| 23 | S ICN=$G(RGRS(991.01)) Q:$G(ICN)']""
|
|---|
| 24 | ;Get DFN
|
|---|
| 25 | S DFN=$$GETDFN^MPIF001(ICN) Q:$G(DFN)'>0
|
|---|
| 26 | Q:+$$SEND2^VAFCUTL1(DFN,"T") ;quit if test patient
|
|---|
| 27 | Q:$$IFLOCAL^MPIF001(DFN)
|
|---|
| 28 | ;Where we're at
|
|---|
| 29 | S HERE=$P($$SITE^VASITE,"^",3)\1
|
|---|
| 30 | NOTPPF ; if not ppf send only to ppf
|
|---|
| 31 | I PPF'=HERE D Q
|
|---|
| 32 | . N PPFLINK,INDEX
|
|---|
| 33 | . D LINK^HLUTIL3(PPFIEN,.PPFLINK)
|
|---|
| 34 | . S INDEX=$O(PPFLINK(0))
|
|---|
| 35 | . I INDEX]"" S HLL("LINKS",1)=CLIENT_"^"_PPFLINK(INDEX)
|
|---|
| 36 | ISPPF ;
|
|---|
| 37 | I PPF=HERE D Q
|
|---|
| 38 | . N PARENT,INDEX,SUBCONTL,CHILDREN,INDEX1,NODE
|
|---|
| 39 | . S NODE=$$MPINODE^MPIFAPI(DFN)
|
|---|
| 40 | . S SUBCONTL=$P($G(NODE),"^",5)
|
|---|
| 41 | . ;Get subscribers, return updated HLL array
|
|---|
| 42 | . ;D GET^RGRSDYN1(DFN,SUBCONTL,+CLASS,CLIENT,.HLL)
|
|---|
| 43 | . D GETLINKS^RGRSDYN1(.HLL)
|
|---|
| 44 | . ;LAST MINUTE CHANGE MARILYN REQUESTED
|
|---|
| 45 | . ;Get MPI link from SITE PARAMETER (when non A01/A03 event, ADT
|
|---|
| 46 | . ;message) part of the DG*5.3*261/RG*1.0*4 bundle gjc@2/4/99
|
|---|
| 47 | . I '$$ADT0103() D
|
|---|
| 48 | . . N MPI S MPI=$$MPILINK^MPIFAPI() D
|
|---|
| 49 | . . . I $P($G(MPI),U)'=-1 S HLL("LINKS",9999999999)=CLIENT_"^"_MPI
|
|---|
| 50 | . . . I $P($G(MPI),U)=-1 D
|
|---|
| 51 | . . . . N RGLOG,RGMTXT
|
|---|
| 52 | . . . . D START^RGHLLOG(HLMTIEN,"","")
|
|---|
| 53 | . . . . S RGMTXT=""
|
|---|
| 54 | . . . . D EXC^RGHLLOG(224,"No MPI link identified in CIRN SITE PARAMETER file (#991.8)"_RGMTXT,$G(DFN))
|
|---|
| 55 | . . . . D STOP^RGHLLOG(0)
|
|---|
| 56 | ;
|
|---|
| 57 | ;the following was commented out because we're not updating all sites
|
|---|
| 58 | ;in the VISN anymore
|
|---|
| 59 | ;
|
|---|
| 60 | ;. ;Get owners PARENT
|
|---|
| 61 | ;. D PARENT^XUAF4("PARENT",PPF)
|
|---|
| 62 | ;. S INDEX=""
|
|---|
| 63 | ;. S INDEX=$O(PARENT("P",INDEX))
|
|---|
| 64 | ;. Q:INDEX']""
|
|---|
| 65 | ;. D LINK^HLUTIL3(INDEX,.CHILDREN)
|
|---|
| 66 | ;. S INDEX=$O(HLL("LINKS",9999999999999),-1)
|
|---|
| 67 | ;. Q:INDEX']""
|
|---|
| 68 | ;. S INDEX1=0
|
|---|
| 69 | ;. F S INDEX1=$O(CHILDREN(INDEX1)) Q:INDEX1'>0 D
|
|---|
| 70 | ;. . S INDEX=INDEX+1
|
|---|
| 71 | ;. . S HLL("LINKS",INDEX)=CLIENT_"^"_CHILDREN(INDEX1)
|
|---|
| 72 | ;
|
|---|
| 73 | ADT0103() ; check to see if this is an ADT message type with an
|
|---|
| 74 | ; event of A01 -or- A03. If true, do not broadcast the message
|
|---|
| 75 | ; to the MPI. Part of the DG*5.3*261/RG*1.0*4 bundle. gjc@2/4/99
|
|---|
| 76 | S HL("MTN")=$G(HL("MTN")),HL("ETN")=$G(HL("ETN")) ; just in case
|
|---|
| 77 | Q $S(HL("MTN")="ADT"&(HL("ETN")="A01"!(HL("ETN")="A03")):1,1:0)
|
|---|
