Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAIPS218

RAIPS218.m

Go to the documentation of this file. 
  1. RAIPS218 ;HIRMFO/GJC - post install routine ; Aug 28, 2024@14:56:21
  1.  ;;5.0;Radiology/Nuclear Medicine;**218**;Mar 16, 1998;Build 1
  1.  ;
  1.  ;Routine           File     IA      Type
  1.  ;---------------------------------------
  1.  ;$$FIND1^DIC                2051    (S)
  1.  ;$$FILE^DIE                 2053    (S)
  1.  ;$$GET1^DIQ                 2056    (S)
  1.  ;                  101      872     (C)
  1.  ;
  1. EN ;main entry point
  1.  ; Set key variables (constants)
  1.  ; -----------------------------
  1.  S RAEVTDRV="RA NTPV2 TCP SERVER RPT",RALOGLINK="RA-NTPV2"
  1.  S RASUBSCRIBER="RA NTPV2 TCP REPORT",RASUBSCRIPT="EN^RAIPS218"
  1.  ; variable list
  1.  ; -------------
  1.  ;RANTP2SRV : IEN of the event driver (FN #101)
  1.  ;RANTP2SUB : IEN of the subscriber   (FN #101)
  1.  ;RANTP2LNK : IEN of the logical link (FN #870)
  1.  ;
  1.  ; Find the IEN of the National Teleradiology Program (NTP) event driver: RAEVTDRV
  1.  ; -------------------------------------------------------------------------------
  1.  S RANTP2SRV=$$FIND1^DIC(101,,"X",RAEVTDRV,,,"RAMSGRT(RASUBSCRIPT)")
  1.  ; Check RANTP2SRV: if RANTP2SRV>0 lookup was successful. If RANTP2SRV equals zero -or-
  1.  ; if RAMSGRT(RASUBSCRIPT,"DIERR") exists the lookup failed. Update user on failure.
  1.  ; the lookup failed.
  1.  I RANTP2SRV=0!($D(RAMSGRT(RASUBSCRIPT,"DIERR"))#2) D  D XIT Q
  1.  .N RATXT S RATXT(1)=" ",RATXT(2)="The lookup for event driver: '"_RAEVTDRV_"' failed."
  1.  .S RATXT(3)="Contact the National Radiology development team."
  1.  .D MES(.RATXT)
  1.  .Q
  1.  ;
  1.  ; Find the IEN of the subscriber to the event driver RAEVTDRV: RASUBSCRIBER
  1.  ; ----------------------------------------------------------------------------
  1.  K RAMSGRT S RANTP2SUB=$$FIND1^DIC(101,,"X",RASUBSCRIBER,,,"RAMSGRT(RASUBSCRIPT)")
  1.  I RANTP2SUB=0!($D(RAMSGRT(RASUBSCRIPT,"DIERR"))#2) D  D XIT Q
  1.  .N RATXT S RATXT(1)=" ",RATXT(2)="The lookup for subscriber: '"_RASUBSCRIBER_"' failed."
  1.  .S RATXT(3)="Contact the National Radiology development team."
  1.  .D MES(.RATXT)
  1.  .Q
  1.  ;
  1.  ; /// begin sanity check ///
  1.  K RAERR S RACHKLL=$$GET1^DIQ(101,RANTP2SUB_",",770.7,,,"RAERR")
  1.  I $D(RAERR("DIERR")) D  D XIT Q
  1.  .N RATXT S RATXT(1)=" ",RATXT(2)="Error in the check of logical link: '"_RALOGLINK_"' being"
  1.  .S RATXT(3)="tied to subscriber protocol: '"_RASUBSCRIBER_"'."
  1.  .S RATXT(4)=" ",RATXT(5)="Error "_$G(RAERR("DIERR",1))_": "_$G(RAERR("DIERR",1,"TEXT",1))
  1.  .S RATXT(6)="Contact the National Radiology development team."
  1.  .D MES(.RATXT)
  1.  .Q
  1.  I RACHKLL=RALOGLINK D  D XIT Q
  1.  .N RATXT S RATXT(1)=" "
  1.  .S RATXT(2)="Logical link '"_RALOGLINK_"' is tied to subscriber protocol '"_RASUBSCRIBER_"'."
  1.  .S RATXT(3)="Exiting successfully without taking further action."
  1.  .D MES(.RATXT)
  1.  .Q
  1.  ; /// end sanity check ///
  1.  ;
  1.  ; Find the IEN of the logical link dedicated to our interface with the
  1.  ; National Teleradiology Program (NTP).
  1.  ; ----------------------------------------------------------------------------
  1.  K RAMSGRT S RANTP2LNK=$$FIND1^DIC(870,,"X",RALOGLINK,,,"RAMSGRT(RASUBSCRIPT)")
  1.  I RANTP2LNK=0!($D(RAMSGRT(RASUBSCRIPT,"DIERR"))#2) D  D XIT Q
  1.  .N RATXT S RATXT(1)=" ",RATXT(2)="The lookup for logical link: '"_RALOGLINK_"' failed."
  1.  .S RATXT(3)="Contact the National Radiology development team."
  1.  .D MES(.RATXT)
  1.  .Q
  1.  ;
  1.  ; Update the subscriber PROTOCOL (#101) file's LOGICAL LINK" (#770.7) field with
  1.  ; RANTP2LNK (internal value).
  1.  S RAIEN=RANTP2SUB_",",RAFDA(101,RAIEN,770.7)=RANTP2LNK
  1.  K RAERR D FILE^DIE("","RAFDA","RAERR")
  1.  I $D(RAERR("DIERR")) D
  1.  .N RATXT S RATXT(1)="Error updating LOGICAL LINK for subscriber: '"_RASUBSCRIBER_"'."
  1.  .S RATXT(2)="Error "_$G(RAERR("DIERR",1))_": "_$G(RAERR("DIERR",1,"TEXT",1))
  1.  .S RATXT(3)="Contact the National Radiology development team."
  1.  .D MES(.RATXT)
  1.  .Q
  1.  E  D
  1.  .N RATXT S RATXT(1)="The process of updating the LOGICAL LINK (#770.7) field with a value"
  1.  .S RATXT(2)="of: '"_RALOGLINK_"' for subscriber protocol: '"_RASUBSCRIBER_"' was successful."
  1.  .D MES(.RATXT)
  1.  .Q
  1.  D XIT
  1.  Q
  1.  ;
  1. MES(RAX) ;display/file text identifying issues, if any, as well as indicating success.
  1.  D MES^XPDUTL(.RAX)
  1.  Q
  1. XIT ;clean up variables and exit the 218 post install
  1.  K DIERR,RACHKLL,RAERR,RAEVTDRV,RAFDA,RAIEN,RALOGLINK,RAMSGRT,RANTP2LNK,RANTP2SRV
  1.  K RANTP2SUB,RASUBSCRIBER,RASUBSCRIPT,RATXT
  1.  Q
  1.  ;