DG53357T.m

DG53357T ; ALB/GRR - POST INIT TO REMOVE INSTITUTION NAME FOR PROTOCOLS ; 10-14-99

 ;;5.3;Registration;**357**;Aug 13, 1993

 ;

EN ;

 W @IOF,"Post Init routine started"

 N DGPROT,DGPIEN,DGPNAME,DGNEWN

 ;

 S DGPROT="DGRU-"

 F  S DGPROT=$O(^ORD(101,"B",DGPROT)) Q:$E(DGPROT,1,5)'="DGRU-"  D

 .I $E(DGPROT,1,8)'="DGRU-RAI"&($E(DGPROT,1,12)'="DGRU-PATIENT") Q  ;not an RAI/MDS protocol

 .I DGPROT["ROUTER"!(DGPROT["SERVER") Q  ;don't rename router and server protocols

 .S DGPIEN=$O(^ORD(101,"B",DGPROT,0)) ;get ien of protocol

 .S DGPNAME=$$GET1^DIQ(101,DGPIEN,.01,"I") ;get current protocol name

 .S DGPAPP=$$GET1^DIQ(101,DGPIEN,770.2,"I") ;get ien of receiving application 

 .S DGNEWN=$P(DGPNAME,"-",1,3)_"-"_DGPAPP

 .S FDA(1,101,DGPIEN_",",.01)=DGNEWN

 .D FILE^DIE("","FDA(1)")

 W !,"Post init routine completed",!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53357T   836     printed  Apr 09, 2024@21:54:29                                                                                                                                                                                                     Page 2

DG53357T  ; ALB/GRR - POST INIT TO REMOVE INSTITUTION NAME FOR PROTOCOLS ; 10-14-99

 +1       ;;5.3;Registration;**357**;Aug 13, 1993

 +2       ;

EN        ;

 +1        WRITE @IOF,"Post Init routine started"

 +2        NEW DGPROT,DGPIEN,DGPNAME,DGNEWN

 +3       ;

 +4        SET DGPROT="DGRU-"

 +5        FOR 

               SET DGPROT=$ORDER(^ORD(101,"B",DGPROT))

               if $EXTRACT(DGPROT,1,5)'="DGRU-"

                   QUIT 

               Begin DoDot:1

 +6       ;not an RAI/MDS protocol

                   IF $EXTRACT(DGPROT,1,8)'="DGRU-RAI"&($EXTRACT(DGPROT,1,12)'="DGRU-PATIENT")

                       QUIT 

 +7       ;don't rename router and server protocols

                   IF DGPROT["ROUTER"!(DGPROT["SERVER")

                       QUIT 

 +8       ;get ien of protocol

                   SET DGPIEN=$ORDER(^ORD(101,"B",DGPROT,0))

 +9       ;get current protocol name

                   SET DGPNAME=$$GET1^DIQ(101,DGPIEN,.01,"I")

 +10      ;get ien of receiving application 

                   SET DGPAPP=$$GET1^DIQ(101,DGPIEN,770.2,"I")

 +11               SET DGNEWN=$PIECE(DGPNAME,"-",1,3)_"-"_DGPAPP

 +12               SET FDA(1,101,DGPIEN_",",.01)=DGNEWN

 +13               DO FILE^DIE("","FDA(1)")

               End DoDot:1

 +14       WRITE !,"Post init routine completed",!

 +15       QUIT