GMRCYP4 ;SLC/DLT - Consult patch 4 pre-init ;7/16/98 09:52
;;3.0;CONSULT/REQUEST TRACKING;**4**;DEC 27, 1997
; (Sub-sections copied from GMRCPRE for GMRC*3.0)
EN ;entry point for patch 4 clean-up
; -- Start over with Request Action Types in 123.1
S $P(^GMR(123.5,0),"^",2)="123.5"
N DIU
;
D STATUS(1,100)
S DIU=123.1 S DIU(0)="DT" D EN^DIU2
;
D STATUS(25,100)
S DIU=123 S DIU(0)="" D EN^DIU2
;
D STATUS(50,100)
S DIU=123.5 S DIU(0)="" D EN^DIU2
;
; -- Remove the menu items on the protocol menus
D RMVITEMS("GMRCACTM SERVICE ACTION MENU")
;
; -- remove data in 6th piece of zero node in ^GMR(123.5,
D OLDATA
Q
;
CHGNAME(GMRCOLD,GMRCNEW) ;Use the old name to find the protocol and update its name.
N DA,DIE,X,Y,DR
S DA=$O(^ORD(101,"B",GMRCOLD,"")) Q:'DA
I $O(^ORD(101,"B",GMRCNEW,0)) D BMES^XPDUTL("Protocol exists: "_$G(GMRCNEW)) Q
D BMES^XPDUTL("Change Protocol Name from: "_$G(GMRCOLD)_" to: "_$G(GMRCNEW))
S DIE="^ORD(101,",DR=".01///^S X=GMRCNEW"
D ^DIE
Q
RMVITEMS(GMRCMENU) ; -- Remove the menu items on the protocol menus
N DA,X,Y,DIE,DIC,DIK,GMRCD0
;
S GMRCD0=$O(^ORD(101,"B",GMRCMENU,"")) Q:'GMRCD0
D BMES^XPDUTL("Remove menu from: "_$G(GMRCMENU))
S DA=0 F TOTL=0:1 S DA=$O(^ORD(101,GMRCD0,10,DA)) Q:'DA
S DA=0 F CURR=0:1 S DA=$O(^ORD(101,GMRCD0,10,DA)) Q:'DA D
. S DA(0)=GMRCD0,DIK="^ORD(101,"_GMRCD0_",10," D ^DIK
. D:TOTL STATUS(((CURR/TOTL)*50)+50,100)
Q
;
STATUS(CURRENT,XPDIDTOT) ;
;
I '$D(XPDIDVT) N XPDIDVT
S XPDIDVT=$G(XPDIDVT)
D UPDATE^XPDID(CURRENT)
;
Q
;
OLDATA ; get rid of data from previous version field
N IEN
S IEN=0 F S IEN=$O(^GMR(123.5,IEN)) Q:'IEN D
. S $P(^GMR(123.5,IEN,0),U,6)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCYP4 1726 printed Sep 23, 2025@19:23:56 Page 2
GMRCYP4 ;SLC/DLT - Consult patch 4 pre-init ;7/16/98 09:52
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4**;DEC 27, 1997
+2 ; (Sub-sections copied from GMRCPRE for GMRC*3.0)
EN ;entry point for patch 4 clean-up
+1 ; -- Start over with Request Action Types in 123.1
+2 SET $PIECE(^GMR(123.5,0),"^",2)="123.5"
+3 NEW DIU
+4 ;
+5 DO STATUS(1,100)
+6 SET DIU=123.1
SET DIU(0)="DT"
DO EN^DIU2
+7 ;
+8 DO STATUS(25,100)
+9 SET DIU=123
SET DIU(0)=""
DO EN^DIU2
+10 ;
+11 DO STATUS(50,100)
+12 SET DIU=123.5
SET DIU(0)=""
DO EN^DIU2
+13 ;
+14 ; -- Remove the menu items on the protocol menus
+15 DO RMVITEMS("GMRCACTM SERVICE ACTION MENU")
+16 ;
+17 ; -- remove data in 6th piece of zero node in ^GMR(123.5,
+18 DO OLDATA
+19 QUIT
+20 ;
CHGNAME(GMRCOLD,GMRCNEW) ;Use the old name to find the protocol and update its name.
+1 NEW DA,DIE,X,Y,DR
+2 SET DA=$ORDER(^ORD(101,"B",GMRCOLD,""))
if 'DA
QUIT
+3 IF $ORDER(^ORD(101,"B",GMRCNEW,0))
DO BMES^XPDUTL("Protocol exists: "_$GET(GMRCNEW))
QUIT
+4 DO BMES^XPDUTL("Change Protocol Name from: "_$GET(GMRCOLD)_" to: "_$GET(GMRCNEW))
+5 SET DIE="^ORD(101,"
SET DR=".01///^S X=GMRCNEW"
+6 DO ^DIE
+7 QUIT
RMVITEMS(GMRCMENU) ; -- Remove the menu items on the protocol menus
+1 NEW DA,X,Y,DIE,DIC,DIK,GMRCD0
+2 ;
+3 SET GMRCD0=$ORDER(^ORD(101,"B",GMRCMENU,""))
if 'GMRCD0
QUIT
+4 DO BMES^XPDUTL("Remove menu from: "_$GET(GMRCMENU))
+5 SET DA=0
FOR TOTL=0:1
SET DA=$ORDER(^ORD(101,GMRCD0,10,DA))
if 'DA
QUIT
+6 SET DA=0
FOR CURR=0:1
SET DA=$ORDER(^ORD(101,GMRCD0,10,DA))
if 'DA
QUIT
Begin DoDot:1
+7 SET DA(0)=GMRCD0
SET DIK="^ORD(101,"_GMRCD0_",10,"
DO ^DIK
+8 if TOTL
DO STATUS(((CURR/TOTL)*50)+50,100)
End DoDot:1
+9 QUIT
+10 ;
STATUS(CURRENT,XPDIDTOT) ;
+1 ;
+2 IF '$DATA(XPDIDVT)
NEW XPDIDVT
+3 SET XPDIDVT=$GET(XPDIDVT)
+4 DO UPDATE^XPDID(CURRENT)
+5 ;
+6 QUIT
+7 ;
OLDATA ; get rid of data from previous version field
+1 NEW IEN
+2 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(123.5,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET $PIECE(^GMR(123.5,IEN,0),U,6)=""
End DoDot:1
+4 QUIT
