- 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 Jan 18, 2025@02:42:42 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