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

GMRCYP4.m

Go to the documentation of this file.
  1. GMRCYP4 ;SLC/DLT - Consult patch 4 pre-init ;7/16/98 09:52
  1. ;;3.0;CONSULT/REQUEST TRACKING;**4**;DEC 27, 1997
  1. ; (Sub-sections copied from GMRCPRE for GMRC*3.0)
  1. EN ;entry point for patch 4 clean-up
  1. ; -- Start over with Request Action Types in 123.1
  1. S $P(^GMR(123.5,0),"^",2)="123.5"
  1. N DIU
  1. ;
  1. D STATUS(1,100)
  1. S DIU=123.1 S DIU(0)="DT" D EN^DIU2
  1. ;
  1. D STATUS(25,100)
  1. S DIU=123 S DIU(0)="" D EN^DIU2
  1. ;
  1. D STATUS(50,100)
  1. S DIU=123.5 S DIU(0)="" D EN^DIU2
  1. ;
  1. ; -- Remove the menu items on the protocol menus
  1. D RMVITEMS("GMRCACTM SERVICE ACTION MENU")
  1. ;
  1. ; -- remove data in 6th piece of zero node in ^GMR(123.5,
  1. D OLDATA
  1. Q
  1. ;
  1. CHGNAME(GMRCOLD,GMRCNEW) ;Use the old name to find the protocol and update its name.
  1. N DA,DIE,X,Y,DR
  1. S DA=$O(^ORD(101,"B",GMRCOLD,"")) Q:'DA
  1. I $O(^ORD(101,"B",GMRCNEW,0)) D BMES^XPDUTL("Protocol exists: "_$G(GMRCNEW)) Q
  1. D BMES^XPDUTL("Change Protocol Name from: "_$G(GMRCOLD)_" to: "_$G(GMRCNEW))
  1. S DIE="^ORD(101,",DR=".01///^S X=GMRCNEW"
  1. D ^DIE
  1. Q
  1. RMVITEMS(GMRCMENU) ; -- Remove the menu items on the protocol menus
  1. N DA,X,Y,DIE,DIC,DIK,GMRCD0
  1. ;
  1. S GMRCD0=$O(^ORD(101,"B",GMRCMENU,"")) Q:'GMRCD0
  1. D BMES^XPDUTL("Remove menu from: "_$G(GMRCMENU))
  1. S DA=0 F TOTL=0:1 S DA=$O(^ORD(101,GMRCD0,10,DA)) Q:'DA
  1. S DA=0 F CURR=0:1 S DA=$O(^ORD(101,GMRCD0,10,DA)) Q:'DA D
  1. . S DA(0)=GMRCD0,DIK="^ORD(101,"_GMRCD0_",10," D ^DIK
  1. . D:TOTL STATUS(((CURR/TOTL)*50)+50,100)
  1. Q
  1. ;
  1. STATUS(CURRENT,XPDIDTOT) ;
  1. ;
  1. I '$D(XPDIDVT) N XPDIDVT
  1. S XPDIDVT=$G(XPDIDVT)
  1. D UPDATE^XPDID(CURRENT)
  1. ;
  1. Q
  1. ;
  1. OLDATA ; get rid of data from previous version field
  1. N IEN
  1. S IEN=0 F S IEN=$O(^GMR(123.5,IEN)) Q:'IEN D
  1. . S $P(^GMR(123.5,IEN,0),U,6)=""
  1. Q