GMRCYP4.m

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

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