Routine: PXRMV1IG

PXRMV1IG ; SLC/PKR - Inits for new REMINDER package (globals).;05/19/2000

 ;;1.5;CLINICAL REMINDERS;;Jun 19, 2000

 ;These routines are used to help converting from old style B

 ;cross-references to new style full length cross-references.

 ;=======================================================================

REINDEX(FILE) ;Rebuild all cross-references in a file.

 ;the second entry is the duplicate.

 N DIK,TEXT

 S TEXT="Rebuilding cross-references in file # "_FILE

 D BMES^XPDUTL(TEXT)

 S DIK=$$ROOT^DILFD(FILE)

 I DIK="" Q

 D IXALL^DIK

 ;=======================================================================

RMDUP(FILE) ;Remove any duplicate entries from file number FILE. We assume

 ;the second entry is the duplicate.

 N DA,DIK,IEN1,IEN2,NAME,NAME1,NAME2,ROOT,ROOTB,TEMP,TEMP1,TEXT

 S TEXT="Checking for duplicate entries in file # "_FILE

 D BMES^XPDUTL(TEXT)

 S ROOT=$$ROOT^DILFD(FILE)

 I ROOT="" Q

 S DIK=ROOT

 S ROOTB=ROOT_"""B"","

 S NAME=""

 S TEMP=ROOTB_""""_NAME_""")"

 F  S NAME=$O(@TEMP) Q:NAME=""  D

 . S TEMP=ROOTB_""""_NAME_""")"

 . S TEMP1=ROOTB_""""_NAME_""","""")"

 . S IEN1=$O(@TEMP1)

 . S TEMP1=ROOTB_""""_NAME_""","_IEN1_")"

 . S IEN2=$O(@TEMP1)

 . I +IEN2>0 D

 .. S TEMP1=ROOT_IEN1_",0)"

 .. S NAME1=$P(@TEMP1,U,1)

 .. S TEMP1=ROOT_IEN2_",0)"

 .. S NAME2=$P(@TEMP1,U,1)

 .. I NAME1=NAME2 D

 ... S TEXT="Removing duplicate entry "_IEN2_" for "_NAME

 ... D BMES^XPDUTL(TEXT)

 ... S DA=IEN2

 ...;Kill nodes 4,6,10, and 20 so none of the cross-references are fired.

 ... I FILE=811.9 D

 .... K ^PXD(811.9,IEN2,4)

 .... K ^PXD(811.9,IEN2,6)

 .... K ^PXD(811.9,IEN2,10)

 .... K ^PXD(811.9,IEN2,20)

 ... D ^DIK

 ;=======================================================================

TMPB(FILE) ;Delete the old B cross-reference and build a new temporary

 ;full length one so the install will find matches. FILE is the file

 ;number.

 N BXREF,IEN,NAME,ROOT,ROOTB,TEMP

 S ROOT=$$ROOT^DILFD(FILE)

 I ROOT="" Q

 S ROOTB=ROOT_"""B"")"

 ;Delete the old B.

 K @ROOTB

 S ROOTB=ROOT_"""B"","""

 S IEN=0

 F  S ENTRY=ROOT_IEN_")",IEN=$O(@ENTRY) Q:+IEN=0  D

 . S TEMP=ROOT_IEN_",0)"

 . S NAME=$P(@TEMP,U,1)

 . S BXREF=ROOTB_NAME_""","_IEN_")"

 . S @(BXREF)=""

 ;=======================================================================

INSAV ;Save inactive status of VA Reminders to file

 N NAME,SUB

 K ^TMP("PXRMV1IG",$J)

 S NAME="VA"

 F  S NAME=$O(^PXD(811.9,"B",NAME)) Q:$E(NAME,1,3)'="VA-"  D

 .S SUB=$O(^PXD(811.9,"B",NAME,"")) Q:'SUB  Q:'$D(^PXD(811.9,SUB,0))

 .S ^TMP("PXRMV1IG",$J,NAME)=$P($G(^PXD(811.9,SUB,0)),U,6)

 ;=======================================================================

INRES ;Restore inactive status of VA reminders

 N NAME,SUB,STA

 S NAME=""

 F  S NAME=$O(^TMP("PXRMV1IG",$J,NAME)) Q:NAME=""  D

 .S STA=$G(^TMP("PXRMV1IG",$J,NAME))

 .S SUB=$O(^PXD(811.9,"B",NAME,"")) Q:'SUB

 .S:$D(^PXD(811.9,SUB,0)) $P(^PXD(811.9,SUB,0),U,6)=STA

 K ^TMP("PXRMV1IG",$J)

 ;=======================================================================

CHANGE ;Rename old menu entries so they get overwritten

 D CHGNAM("PXRM REMINDER MENU","PXRM MANAGERS MENU")

 ;=======================================================================

CHGNAM(OLD,NEW) ;Change option name

 ;Skip if the new entry already exists

 I $D(^DIC(19,"B",NEW)) Q

 ;Rename option

 N DA,DIE,DR,X

 S DA=$O(^DIC(19,"B",OLD,"")) Q:'DA

 S DIE="^DIC(19,",DR=".01///^S X=NEW"

 D ^DIE

PXRMV1IG  ; SLC/PKR - Inits for new REMINDER package (globals).;05/19/2000

 +1       ;;1.5;CLINICAL REMINDERS;;Jun 19, 2000

 +2       ;

 +3       ;These routines are used to help converting from old style B

 +4       ;cross-references to new style full length cross-references.

 +5       ;

 +6       ;=======================================================================

REINDEX(FILE) ;Rebuild all cross-references in a file.

 +1       ;the second entry is the duplicate.

 +2        NEW DIK,TEXT

 +3        SET TEXT="Rebuilding cross-references in file # "_FILE

 +4        DO BMES^XPDUTL(TEXT)

 +5        SET DIK=$$ROOT^DILFD(FILE)

 +6        IF DIK=""

               QUIT

 +7        DO IXALL^DIK

 +8        QUIT

 +9       ;

 +10      ;=======================================================================

RMDUP(FILE) ;Remove any duplicate entries from file number FILE. We assume

 +1       ;the second entry is the duplicate.

 +2        NEW DA,DIK,IEN1,IEN2,NAME,NAME1,NAME2,ROOT,ROOTB,TEMP,TEMP1,TEXT

 +3        SET TEXT="Checking for duplicate entries in file # "_FILE

 +4        DO BMES^XPDUTL(TEXT)

 +5        SET ROOT=$$ROOT^DILFD(FILE)

 +6        IF ROOT=""

               QUIT

 +7        SET DIK=ROOT

 +8        SET ROOTB=ROOT_"""B"","

 +9        SET NAME=""

 +10       SET TEMP=ROOTB_""""_NAME_""")"

 +11       FOR

               SET NAME=$ORDER(@TEMP)

               IF NAME=""

                   QUIT

               Begin DoDot:1

 +12               SET TEMP=ROOTB_""""_NAME_""")"

 +13               SET TEMP1=ROOTB_""""_NAME_""","""")"

 +14               SET IEN1=$ORDER(@TEMP1)

 +15               SET TEMP1=ROOTB_""""_NAME_""","_IEN1_")"

 +16               SET IEN2=$ORDER(@TEMP1)

 +17               IF +IEN2>0

                       Begin DoDot:2

 +18                       SET TEMP1=ROOT_IEN1_",0)"

 +19                       SET NAME1=$PIECE(@TEMP1,U,1)

 +20                       SET TEMP1=ROOT_IEN2_",0)"

 +21                       SET NAME2=$PIECE(@TEMP1,U,1)

 +22                       IF NAME1=NAME2

                               Begin DoDot:3

 +23                               SET TEXT="Removing duplicate entry "_IEN2_" for "_NAME

 +24                               DO BMES^XPDUTL(TEXT)

 +25                               SET DA=IEN2

 +26      ;Kill nodes 4,6,10, and 20 so none of the cross-references are fired.

 +27                               IF FILE=811.9

                                       Begin DoDot:4

 +28                                       KILL ^PXD(811.9,IEN2,4)

 +29                                       KILL ^PXD(811.9,IEN2,6)

 +30                                       KILL ^PXD(811.9,IEN2,10)

 +31                                       KILL ^PXD(811.9,IEN2,20)

                                       End DoDot:4

 +32                               DO ^DIK

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +33       QUIT

 +34      ;

 +35      ;=======================================================================

TMPB(FILE) ;Delete the old B cross-reference and build a new temporary

 +1       ;full length one so the install will find matches. FILE is the file

 +2       ;number.

 +3        NEW BXREF,IEN,NAME,ROOT,ROOTB,TEMP

 +4        SET ROOT=$$ROOT^DILFD(FILE)

 +5        IF ROOT=""

               QUIT

 +6        SET ROOTB=ROOT_"""B"")"

 +7       ;Delete the old B.

 +8        KILL @ROOTB

 +9        SET ROOTB=ROOT_"""B"","""

 +10       SET IEN=0

 +11       FOR

               SET ENTRY=ROOT_IEN_")"

               SET IEN=$ORDER(@ENTRY)

               IF +IEN=0

                   QUIT

               Begin DoDot:1

 +12               SET TEMP=ROOT_IEN_",0)"

 +13               SET NAME=$PIECE(@TEMP,U,1)

 +14               SET BXREF=ROOTB_NAME_""","_IEN_")"

 +15               SET @(BXREF)=""

               End DoDot:1

 +16       QUIT

 +17      ;

 +18      ;=======================================================================

INSAV     ;Save inactive status of VA Reminders to file

 +1        NEW NAME,SUB

 +2        KILL ^TMP("PXRMV1IG",$JOB)

 +3        SET NAME="VA"

 +4        FOR

               SET NAME=$ORDER(^PXD(811.9,"B",NAME))

               IF $EXTRACT(NAME,1,3)'="VA-"

                   QUIT

               Begin DoDot:1

 +5                SET SUB=$ORDER(^PXD(811.9,"B",NAME,""))

                   IF 'SUB

                       QUIT

                   IF '$DATA(^PXD(811.9,SUB,0))

                       QUIT

 +6                SET ^TMP("PXRMV1IG",$JOB,NAME)=$PIECE($GET(^PXD(811.9,SUB,0)),U,6)

               End DoDot:1

 +7        QUIT

 +8       ;

 +9       ;=======================================================================

INRES     ;Restore inactive status of VA reminders

 +1        NEW NAME,SUB,STA

 +2        SET NAME=""

 +3        FOR

               SET NAME=$ORDER(^TMP("PXRMV1IG",$JOB,NAME))

               IF NAME=""

                   QUIT

               Begin DoDot:1

 +4                SET STA=$GET(^TMP("PXRMV1IG",$JOB,NAME))

 +5                SET SUB=$ORDER(^PXD(811.9,"B",NAME,""))

                   IF 'SUB

                       QUIT

 +6                IF $DATA(^PXD(811.9,SUB,0))

                       SET $PIECE(^PXD(811.9,SUB,0),U,6)=STA

               End DoDot:1

 +7        KILL ^TMP("PXRMV1IG",$JOB)

 +8        QUIT

 +9       ;

 +10      ;=======================================================================

CHANGE    ;Rename old menu entries so they get overwritten

 +1        DO CHGNAM("PXRM REMINDER MENU","PXRM MANAGERS MENU")

 +2        QUIT

 +3       ;

 +4       ;=======================================================================

CHGNAM(OLD,NEW) ;Change option name

 +1       ;Skip if the new entry already exists

 +2        IF $DATA(^DIC(19,"B",NEW))

               QUIT

 +3       ;Rename option

 +4        NEW DA,DIE,DR,X

 +5        SET DA=$ORDER(^DIC(19,"B",OLD,""))

           IF 'DA

               QUIT

 +6        SET DIE="^DIC(19,"

           SET DR=".01///^S X=NEW"

 +7        DO ^DIE

 +8        QUIT

PXRMV1IG.m