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

DG53357T.m

Go to the documentation of this file.
  1. DG53357T ; ALB/GRR - POST INIT TO REMOVE INSTITUTION NAME FOR PROTOCOLS ; 10-14-99
  1. ;;5.3;Registration;**357,1015**;Aug 13, 1993;Build 21
  1. ;
  1. EN ;
  1. W @IOF,"Post Init routine started"
  1. N DGPROT,DGPIEN,DGPNAME,DGNEWN
  1. ;
  1. S DGPROT="DGRU-"
  1. F S DGPROT=$O(^ORD(101,"B",DGPROT)) Q:$E(DGPROT,1,5)'="DGRU-" D
  1. .I $E(DGPROT,1,8)'="DGRU-RAI"&($E(DGPROT,1,12)'="DGRU-PATIENT") Q ;not an RAI/MDS protocol
  1. .I DGPROT["ROUTER"!(DGPROT["SERVER") Q ;don't rename router and server protocols
  1. .S DGPIEN=$O(^ORD(101,"B",DGPROT,0)) ;get ien of protocol
  1. .S DGPNAME=$$GET1^DIQ(101,DGPIEN,.01,"I") ;get current protocol name
  1. .S DGPAPP=$$GET1^DIQ(101,DGPIEN,770.2,"I") ;get ien of receiving application
  1. .S DGNEWN=$P(DGPNAME,"-",1,3)_"-"_DGPAPP
  1. .S FDA(1,101,DGPIEN_",",.01)=DGNEWN
  1. .D FILE^DIE("","FDA(1)")
  1. W !,"Post init routine completed",!
  1. Q