- DG53357T ; ALB/GRR - POST INIT TO REMOVE INSTITUTION NAME FOR PROTOCOLS ; 10-14-99
- ;;5.3;Registration;**357,1015**;Aug 13, 1993;Build 21
- ;
- 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
- 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
- +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