| 1 | RGADTUT ;HIRMFO/GJC-utility; determine pat. subscriptions (A01/A03) ;09/21/99
 | 
|---|
| 2 |  ;;1.0;CLINICAL INFO RESOURCE NETWORK;**17**;30 Apr 99
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; Integration Agreements (IAs) utilized in this application:
 | 
|---|
| 5 |  ; #2270-call to HLSUB (ACT, GET & UPDATE)
 | 
|---|
| 6 |  ; #2271-call to LINK^HLUTIL3
 | 
|---|
| 7 |  ; #2541-call to $$KSP^XUPARAM
 | 
|---|
| 8 |  ; #2706-call to $$UPDATE^MPIFAPI
 | 
|---|
| 9 |  ; #2796-call to RGHLLOG (EXC, START & STOP)
 | 
|---|
| 10 |  ; #2988-call to FILE^VAFCTFU
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 |  ; Note: SHARE function is called from RGADT1 to determine if VistA HL7
 | 
|---|
| 13 |  ; messages are to be built (is GENERATE^HLMA to be called?)
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 | SHARE(RGZSTR) ; determine if the patient is shared:
 | 
|---|
| 16 |  ; a) If shared, return one to RGADT1 and call GENERATE^HLMA
 | 
|---|
| 17 |  ; b) If not shared and the host facility is the CMOR, update
 | 
|---|
| 18 |  ;    host TFL record, do not call GENERATE^HLMA
 | 
|---|
| 19 |  ; c) If not shared and the host facility is not the CMOR, add
 | 
|---|
| 20 |  ;    the CMOR to the subscription list, return one to RGADT1
 | 
|---|
| 21 |  ;    and call GENERATE^HLMA
 | 
|---|
| 22 |  ;
 | 
|---|
| 23 |  ; input=> RGZSTR-patient_dfn^date_last_treated^event_type
 | 
|---|
| 24 |  ; yield=> 0 to prevent calling GENERATE^HLMA, else make the call
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 |  ; note: 1) Event Type will equal A01 or A03.  This needs to be
 | 
|---|
| 27 |  ;          converted a valid ADT/HL7 EVENT REASON (#391.72) entry.
 | 
|---|
| 28 |  ;       2) RGSD101 & RGDG101 are assumed to have a global scope
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 |  N HLDT,HLINKP,HLINKX,RGZCMOR,RGZDFN,RGZDT,RGZEVT,RGZFLG,RGZHLL,RGZMPI
 | 
|---|
| 31 |  N RGZSF,RGZSUB
 | 
|---|
| 32 |  S RGZDFN=$P(RGZSTR,"^"),RGZDT=$P(RGZSTR,"^",2),RGZEVT=$P(RGZSTR,"^",3)
 | 
|---|
| 33 |  S RGZMPI=$$MPINODE^MPIFAPI(RGZDFN),RGZSF=$$KSP^XUPARAM("INST")
 | 
|---|
| 34 |  ; note to myself: missing MPI node, update TFL & return 0
 | 
|---|
| 35 |  ;I +RGZMPI=-1 D TFL Q 0 <= should never occur, RGADT1 checks for ICN
 | 
|---|
| 36 |  S RGZCMOR=$P($G(RGZMPI),"^",3),RGZSUB=$P($G(RGZMPI),"^",5)
 | 
|---|
| 37 |  D:RGZSUB GET^HLSUB(RGZSUB,0,,.RGZHLL) ; find shared sites
 | 
|---|
| 38 |  S RGZFLG=+$O(RGZHLL("LINKS",$C(32)),-1)
 | 
|---|
| 39 |  ; at this point if RGZFLG>0 yield RGZFLG, else evaluate the conditions
 | 
|---|
| 40 |  ; listed above (b & c)
 | 
|---|
| 41 |  I 'RGZFLG D  ; no shared sites, take action (RGZFLG may be reset)
 | 
|---|
| 42 |  .I 'RGZCMOR D TFL Q  ;CMOR not found, subsequent conditions not met
 | 
|---|
| 43 |  .;
 | 
|---|
| 44 |  .;b) the host site is the CMOR, update local TFL record, quit
 | 
|---|
| 45 |  .I RGZSF,(RGZSF=RGZCMOR) D TFL Q
 | 
|---|
| 46 |  .;
 | 
|---|
| 47 |  .;c) if we're not the CMOR, we'll add the CMOR to the subscription list
 | 
|---|
| 48 |  .I RGZSF,(RGZSF'=RGZCMOR) D
 | 
|---|
| 49 |  ..N RGZ774,RGZERR,RGZLL
 | 
|---|
| 50 |  ..D LINK^HLUTIL3(RGZCMOR,.RGZLL)
 | 
|---|
| 51 |  ..;log. link for CMOR missing, log exception, file data in TFL & quit
 | 
|---|
| 52 |  ..I '$O(RGZLL(0)) D  Q
 | 
|---|
| 53 |  ...D EXC("Cannot add CMOR (#4): "_RGZCMOR_", as a subscriber to: "_RGZSF_" (#4)")
 | 
|---|
| 54 |  ...D TFL
 | 
|---|
| 55 |  ...Q
 | 
|---|
| 56 |  ..;found the CMOR's logical link, add the subscription
 | 
|---|
| 57 |  ..S RGZLL=RGZLL($O(RGZLL(0))),RGZ774=$$ACT^HLSUB
 | 
|---|
| 58 |  ..D UPD^HLSUB(RGZ774,RGZLL,1,"","","",.RGZERR)
 | 
|---|
| 59 |  ..; if update errored: log exception, file data into TFL & quit
 | 
|---|
| 60 |  ..I $O(RGZERR(0)) D  Q
 | 
|---|
| 61 |  ...D EXC("Subscription add (#774) failed for DFN: "_RGZDFN_", subscriber: "_RGZLL)
 | 
|---|
| 62 |  ...D TFL
 | 
|---|
| 63 |  ...Q
 | 
|---|
| 64 |  ..;subscription added, set flag (HL7 message can be generated)
 | 
|---|
| 65 |  ..E  S RGZFLG=1
 | 
|---|
| 66 |  ..;update the SUBSCRIPTION CONTROL NUMBER (#991.05) field, file #2
 | 
|---|
| 67 |  ..K RGZERR N RGZARR
 | 
|---|
| 68 |  ..S RGZARR(991.05)=RGZ774,RGZERR=$$UPDATE^MPIFAPI(RGZDFN,"RGZARR")
 | 
|---|
| 69 |  ..;if error updating field, file an exception
 | 
|---|
| 70 |  ..I +RGZERR=-1 D EXC("Subscription add (fld: 991.05, file: #2) failed for DFN: "_RGZDFN_", subscriber: "_RGZLL)
 | 
|---|
| 71 |  ..Q
 | 
|---|
| 72 |  .Q
 | 
|---|
| 73 |  Q RGZFLG ;shared site(s) found/added? 0=no, else yes...
 | 
|---|
| 74 |  ;
 | 
|---|
| 75 | EXC(RGX) ; log an exception because:
 | 
|---|
| 76 |  ;a) logical link not found for CMOR
 | 
|---|
| 77 |  ;b) new subscription not added to Subscription Control (#774) file
 | 
|---|
| 78 |  ;c) subscription control pointer not added to "MPI" node (fld: 991.05)
 | 
|---|
| 79 |  ; input: RGX-exception text
 | 
|---|
| 80 |  D START^RGHLLOG(),EXC^RGHLLOG(224,RGX,RGZDFN),STOP^RGHLLOG(0)
 | 
|---|
| 81 |  Q
 | 
|---|
| 82 | TFL ; update the Treating Facility List file on:
 | 
|---|
| 83 |  ; an exception -or- no subscribers CMOR data missing -or-
 | 
|---|
| 84 |  ; "MPI" node missing -or- no subscribers & host is the CMOR
 | 
|---|
| 85 |  ; Note: RGZSF is global in scope
 | 
|---|
| 86 |  N RGZEVR I RGZEVT="A01" S RGZEVR="A1"
 | 
|---|
| 87 |  E  S RGZEVR=$S(($D(RGSD101))#2:"A3",1:"A2")
 | 
|---|
| 88 |  D:RGZSF FILE^VAFCTFU(RGZDFN,RGZSF_"^"_RGZDT_"^"_RGZEVR,1)
 | 
|---|
| 89 |  ;3rd param=1, do not involve the ADT/HL7 PIVOT (#391.71) file
 | 
|---|
| 90 |  Q
 | 
|---|