- 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 Jan 18, 2025@02:49:08 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