GMRCPOS2.m

GMRCPOS2 ; SLC/DLT - Consult postinit file maintenance ;2/18/99 15:04

 ;;3.0;CONSULT/REQUEST TRACKING;**2**;DEC 27, 1997

EN ; -- postinit

 N GMRCEND

 D FIX101

 Q

FIX101 ; Move the GMRCR prefixed protocols "File Link" values from the

 ; CONSULTS PARAMETERS FILE 123.9 to the GMRCR protocol entry

 ;

 N DA,DIE,DR,FILELINK,SITE,NAME,SERVICE

 S SITE=$O(^GMR(123.9,0)) I 'SITE D BMES^XPDUTL("CONSULTS PARAMETERS FILE not defined. Stopped PROTOCOL FILE cleanup!") S GMRCEND=1 Q

 ;

 I '$D(^GMR(123.9,SITE,99,0)) D  Q:GMRCEND

 .D BMES^XPDUTL("No GMRCR protocols saved before CONSULT/REQUEST TRACKING V 3.0 installation")

 .D BMES^XPDUTL("Need to MANUALLY correct the GMRCR-prefixed PROTOCOL FILE, FILE LINK field")

 .S GMRCEND=1 Q

 ;

 S DA=0 F  S DA=$O(^GMR(123.9,SITE,99,DA)) Q:'DA  D

 . S FILELINK=$P($G(^GMR(123.9,SITE,99,DA,0)),"^",2)

 . S NAME=$P($G(^ORD(101,DA,0)),U,1) I '$L(NAME) D  Q

 .. D BMES^XPDUTL("No FILE LINK update for PROTOCOL: PROTOCOL "_DA_" no longer defined")

 . S SERVICE=$P($G(^GMR(123.5,+FILELINK,0)),"^",1)

 . Q:FILELINK=$P($G(^ORD(101,DA,5)),"^",1)  ;no update needed

 . S DIE="^ORD(101,",DR="6////^S X=FILELINK"

 . D ^DIE

 . D BMES^XPDUTL("Changed PROTOCOL: "_NAME_", FILE LINK field to: "_SERVICE)

 . Q

 Q

GMRCPOS2  ; SLC/DLT - Consult postinit file maintenance ;2/18/99 15:04

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**2**;DEC 27, 1997

EN        ; -- postinit

 +1        NEW GMRCEND

 +2        DO FIX101

 +3        QUIT 

FIX101    ; Move the GMRCR prefixed protocols "File Link" values from the

 +1       ; CONSULTS PARAMETERS FILE 123.9 to the GMRCR protocol entry

 +2       ;

 +3        NEW DA,DIE,DR,FILELINK,SITE,NAME,SERVICE

 +4        SET SITE=$ORDER(^GMR(123.9,0))

           IF 'SITE

               DO BMES^XPDUTL("CONSULTS PARAMETERS FILE not defined. Stopped PROTOCOL FILE cleanup!")

               SET GMRCEND=1

               QUIT 

 +5       ;

 +6        IF '$DATA(^GMR(123.9,SITE,99,0))

               Begin DoDot:1

 +7                DO BMES^XPDUTL("No GMRCR protocols saved before CONSULT/REQUEST TRACKING V 3.0 installation")

 +8                DO BMES^XPDUTL("Need to MANUALLY correct the GMRCR-prefixed PROTOCOL FILE, FILE LINK field")

 +9                SET GMRCEND=1

                   QUIT 

               End DoDot:1

               IF GMRCEND

                   QUIT 

 +10      ;

 +11       SET DA=0

           FOR 

               SET DA=$ORDER(^GMR(123.9,SITE,99,DA))

               IF 'DA

                   QUIT 

               Begin DoDot:1

 +12               SET FILELINK=$PIECE($GET(^GMR(123.9,SITE,99,DA,0)),"^",2)

 +13               SET NAME=$PIECE($GET(^ORD(101,DA,0)),U,1)

                   IF '$LENGTH(NAME)

                       Begin DoDot:2

 +14                       DO BMES^XPDUTL("No FILE LINK update for PROTOCOL: PROTOCOL "_DA_" no longer defined")

                       End DoDot:2

                       QUIT 

 +15               SET SERVICE=$PIECE($GET(^GMR(123.5,+FILELINK,0)),"^",1)

 +16      ;no update needed

                   IF FILELINK=$PIECE($GET(^ORD(101,DA,5)),"^",1)

                       QUIT 

 +17               SET DIE="^ORD(101,"

                   SET DR="6////^S X=FILELINK"

 +18               DO ^DIE

 +19               DO BMES^XPDUTL("Changed PROTOCOL: "_NAME_", FILE LINK field to: "_SERVICE)

 +20               QUIT 

               End DoDot:1

 +21       QUIT