| 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 | 
|---|