RAIPS218 ;HIRMFO/GJC - post install routine ; Aug 28, 2024@14:56:21
;;5.0;Radiology/Nuclear Medicine;**218**;Mar 16, 1998;Build 1
;
;Routine File IA Type
;---------------------------------------
;$$FIND1^DIC 2051 (S)
;$$FILE^DIE 2053 (S)
;$$GET1^DIQ 2056 (S)
; 101 872 (C)
;
EN ;main entry point
; Set key variables (constants)
; -----------------------------
S RAEVTDRV="RA NTPV2 TCP SERVER RPT",RALOGLINK="RA-NTPV2"
S RASUBSCRIBER="RA NTPV2 TCP REPORT",RASUBSCRIPT="EN^RAIPS218"
; variable list
; -------------
;RANTP2SRV : IEN of the event driver (FN #101)
;RANTP2SUB : IEN of the subscriber (FN #101)
;RANTP2LNK : IEN of the logical link (FN #870)
;
; Find the IEN of the National Teleradiology Program (NTP) event driver: RAEVTDRV
; -------------------------------------------------------------------------------
S RANTP2SRV=$$FIND1^DIC(101,,"X",RAEVTDRV,,,"RAMSGRT(RASUBSCRIPT)")
; Check RANTP2SRV: if RANTP2SRV>0 lookup was successful. If RANTP2SRV equals zero -or-
; if RAMSGRT(RASUBSCRIPT,"DIERR") exists the lookup failed. Update user on failure.
; the lookup failed.
I RANTP2SRV=0!($D(RAMSGRT(RASUBSCRIPT,"DIERR"))#2) D D XIT Q
.N RATXT S RATXT(1)=" ",RATXT(2)="The lookup for event driver: '"_RAEVTDRV_"' failed."
.S RATXT(3)="Contact the National Radiology development team."
.D MES(.RATXT)
.Q
;
; Find the IEN of the subscriber to the event driver RAEVTDRV: RASUBSCRIBER
; ----------------------------------------------------------------------------
K RAMSGRT S RANTP2SUB=$$FIND1^DIC(101,,"X",RASUBSCRIBER,,,"RAMSGRT(RASUBSCRIPT)")
I RANTP2SUB=0!($D(RAMSGRT(RASUBSCRIPT,"DIERR"))#2) D D XIT Q
.N RATXT S RATXT(1)=" ",RATXT(2)="The lookup for subscriber: '"_RASUBSCRIBER_"' failed."
.S RATXT(3)="Contact the National Radiology development team."
.D MES(.RATXT)
.Q
;
; /// begin sanity check ///
K RAERR S RACHKLL=$$GET1^DIQ(101,RANTP2SUB_",",770.7,,,"RAERR")
I $D(RAERR("DIERR")) D D XIT Q
.N RATXT S RATXT(1)=" ",RATXT(2)="Error in the check of logical link: '"_RALOGLINK_"' being"
.S RATXT(3)="tied to subscriber protocol: '"_RASUBSCRIBER_"'."
.S RATXT(4)=" ",RATXT(5)="Error "_$G(RAERR("DIERR",1))_": "_$G(RAERR("DIERR",1,"TEXT",1))
.S RATXT(6)="Contact the National Radiology development team."
.D MES(.RATXT)
.Q
I RACHKLL=RALOGLINK D D XIT Q
.N RATXT S RATXT(1)=" "
.S RATXT(2)="Logical link '"_RALOGLINK_"' is tied to subscriber protocol '"_RASUBSCRIBER_"'."
.S RATXT(3)="Exiting successfully without taking further action."
.D MES(.RATXT)
.Q
; /// end sanity check ///
;
; Find the IEN of the logical link dedicated to our interface with the
; National Teleradiology Program (NTP).
; ----------------------------------------------------------------------------
K RAMSGRT S RANTP2LNK=$$FIND1^DIC(870,,"X",RALOGLINK,,,"RAMSGRT(RASUBSCRIPT)")
I RANTP2LNK=0!($D(RAMSGRT(RASUBSCRIPT,"DIERR"))#2) D D XIT Q
.N RATXT S RATXT(1)=" ",RATXT(2)="The lookup for logical link: '"_RALOGLINK_"' failed."
.S RATXT(3)="Contact the National Radiology development team."
.D MES(.RATXT)
.Q
;
; Update the subscriber PROTOCOL (#101) file's LOGICAL LINK" (#770.7) field with
; RANTP2LNK (internal value).
S RAIEN=RANTP2SUB_",",RAFDA(101,RAIEN,770.7)=RANTP2LNK
K RAERR D FILE^DIE("","RAFDA","RAERR")
I $D(RAERR("DIERR")) D
.N RATXT S RATXT(1)="Error updating LOGICAL LINK for subscriber: '"_RASUBSCRIBER_"'."
.S RATXT(2)="Error "_$G(RAERR("DIERR",1))_": "_$G(RAERR("DIERR",1,"TEXT",1))
.S RATXT(3)="Contact the National Radiology development team."
.D MES(.RATXT)
.Q
E D
.N RATXT S RATXT(1)="The process of updating the LOGICAL LINK (#770.7) field with a value"
.S RATXT(2)="of: '"_RALOGLINK_"' for subscriber protocol: '"_RASUBSCRIBER_"' was successful."
.D MES(.RATXT)
.Q
D XIT
Q
;
MES(RAX) ;display/file text identifying issues, if any, as well as indicating success.
D MES^XPDUTL(.RAX)
Q
XIT ;clean up variables and exit the 218 post install
K DIERR,RACHKLL,RAERR,RAEVTDRV,RAFDA,RAIEN,RALOGLINK,RAMSGRT,RANTP2LNK,RANTP2SRV
K RANTP2SUB,RASUBSCRIBER,RASUBSCRIPT,RATXT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS218 4266 printed Dec 13, 2024@02:36:26 Page 2
RAIPS218 ;HIRMFO/GJC - post install routine ; Aug 28, 2024@14:56:21
+1 ;;5.0;Radiology/Nuclear Medicine;**218**;Mar 16, 1998;Build 1
+2 ;
+3 ;Routine File IA Type
+4 ;---------------------------------------
+5 ;$$FIND1^DIC 2051 (S)
+6 ;$$FILE^DIE 2053 (S)
+7 ;$$GET1^DIQ 2056 (S)
+8 ; 101 872 (C)
+9 ;
EN ;main entry point
+1 ; Set key variables (constants)
+2 ; -----------------------------
+3 SET RAEVTDRV="RA NTPV2 TCP SERVER RPT"
SET RALOGLINK="RA-NTPV2"
+4 SET RASUBSCRIBER="RA NTPV2 TCP REPORT"
SET RASUBSCRIPT="EN^RAIPS218"
+5 ; variable list
+6 ; -------------
+7 ;RANTP2SRV : IEN of the event driver (FN #101)
+8 ;RANTP2SUB : IEN of the subscriber (FN #101)
+9 ;RANTP2LNK : IEN of the logical link (FN #870)
+10 ;
+11 ; Find the IEN of the National Teleradiology Program (NTP) event driver: RAEVTDRV
+12 ; -------------------------------------------------------------------------------
+13 SET RANTP2SRV=$$FIND1^DIC(101,,"X",RAEVTDRV,,,"RAMSGRT(RASUBSCRIPT)")
+14 ; Check RANTP2SRV: if RANTP2SRV>0 lookup was successful. If RANTP2SRV equals zero -or-
+15 ; if RAMSGRT(RASUBSCRIPT,"DIERR") exists the lookup failed. Update user on failure.
+16 ; the lookup failed.
+17 IF RANTP2SRV=0!($DATA(RAMSGRT(RASUBSCRIPT,"DIERR"))#2)
Begin DoDot:1
+18 NEW RATXT
SET RATXT(1)=" "
SET RATXT(2)="The lookup for event driver: '"_RAEVTDRV_"' failed."
+19 SET RATXT(3)="Contact the National Radiology development team."
+20 DO MES(.RATXT)
+21 QUIT
End DoDot:1
DO XIT
QUIT
+22 ;
+23 ; Find the IEN of the subscriber to the event driver RAEVTDRV: RASUBSCRIBER
+24 ; ----------------------------------------------------------------------------
+25 KILL RAMSGRT
SET RANTP2SUB=$$FIND1^DIC(101,,"X",RASUBSCRIBER,,,"RAMSGRT(RASUBSCRIPT)")
+26 IF RANTP2SUB=0!($DATA(RAMSGRT(RASUBSCRIPT,"DIERR"))#2)
Begin DoDot:1
+27 NEW RATXT
SET RATXT(1)=" "
SET RATXT(2)="The lookup for subscriber: '"_RASUBSCRIBER_"' failed."
+28 SET RATXT(3)="Contact the National Radiology development team."
+29 DO MES(.RATXT)
+30 QUIT
End DoDot:1
DO XIT
QUIT
+31 ;
+32 ; /// begin sanity check ///
+33 KILL RAERR
SET RACHKLL=$$GET1^DIQ(101,RANTP2SUB_",",770.7,,,"RAERR")
+34 IF $DATA(RAERR("DIERR"))
Begin DoDot:1
+35 NEW RATXT
SET RATXT(1)=" "
SET RATXT(2)="Error in the check of logical link: '"_RALOGLINK_"' being"
+36 SET RATXT(3)="tied to subscriber protocol: '"_RASUBSCRIBER_"'."
+37 SET RATXT(4)=" "
SET RATXT(5)="Error "_$GET(RAERR("DIERR",1))_": "_$GET(RAERR("DIERR",1,"TEXT",1))
+38 SET RATXT(6)="Contact the National Radiology development team."
+39 DO MES(.RATXT)
+40 QUIT
End DoDot:1
DO XIT
QUIT
+41 IF RACHKLL=RALOGLINK
Begin DoDot:1
+42 NEW RATXT
SET RATXT(1)=" "
+43 SET RATXT(2)="Logical link '"_RALOGLINK_"' is tied to subscriber protocol '"_RASUBSCRIBER_"'."
+44 SET RATXT(3)="Exiting successfully without taking further action."
+45 DO MES(.RATXT)
+46 QUIT
End DoDot:1
DO XIT
QUIT
+47 ; /// end sanity check ///
+48 ;
+49 ; Find the IEN of the logical link dedicated to our interface with the
+50 ; National Teleradiology Program (NTP).
+51 ; ----------------------------------------------------------------------------
+52 KILL RAMSGRT
SET RANTP2LNK=$$FIND1^DIC(870,,"X",RALOGLINK,,,"RAMSGRT(RASUBSCRIPT)")
+53 IF RANTP2LNK=0!($DATA(RAMSGRT(RASUBSCRIPT,"DIERR"))#2)
Begin DoDot:1
+54 NEW RATXT
SET RATXT(1)=" "
SET RATXT(2)="The lookup for logical link: '"_RALOGLINK_"' failed."
+55 SET RATXT(3)="Contact the National Radiology development team."
+56 DO MES(.RATXT)
+57 QUIT
End DoDot:1
DO XIT
QUIT
+58 ;
+59 ; Update the subscriber PROTOCOL (#101) file's LOGICAL LINK" (#770.7) field with
+60 ; RANTP2LNK (internal value).
+61 SET RAIEN=RANTP2SUB_","
SET RAFDA(101,RAIEN,770.7)=RANTP2LNK
+62 KILL RAERR
DO FILE^DIE("","RAFDA","RAERR")
+63 IF $DATA(RAERR("DIERR"))
Begin DoDot:1
+64 NEW RATXT
SET RATXT(1)="Error updating LOGICAL LINK for subscriber: '"_RASUBSCRIBER_"'."
+65 SET RATXT(2)="Error "_$GET(RAERR("DIERR",1))_": "_$GET(RAERR("DIERR",1,"TEXT",1))
+66 SET RATXT(3)="Contact the National Radiology development team."
+67 DO MES(.RATXT)
+68 QUIT
End DoDot:1
+69 IF '$TEST
Begin DoDot:1
+70 NEW RATXT
SET RATXT(1)="The process of updating the LOGICAL LINK (#770.7) field with a value"
+71 SET RATXT(2)="of: '"_RALOGLINK_"' for subscriber protocol: '"_RASUBSCRIBER_"' was successful."
+72 DO MES(.RATXT)
+73 QUIT
End DoDot:1
+74 DO XIT
+75 QUIT
+76 ;
MES(RAX) ;display/file text identifying issues, if any, as well as indicating success.
+1 DO MES^XPDUTL(.RAX)
+2 QUIT
XIT ;clean up variables and exit the 218 post install
+1 KILL DIERR,RACHKLL,RAERR,RAEVTDRV,RAFDA,RAIEN,RALOGLINK,RAMSGRT,RANTP2LNK,RANTP2SRV
+2 KILL RANTP2SUB,RASUBSCRIBER,RASUBSCRIPT,RATXT
+3 QUIT
+4 ;
