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