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
Q
;
;=======================================================================
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
Q
;
;=======================================================================
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)=""
Q
;
;=======================================================================
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)
Q
;
;=======================================================================
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)
Q
;
;=======================================================================
CHANGE ;Rename old menu entries so they get overwritten
D CHGNAM("PXRM REMINDER MENU","PXRM MANAGERS MENU")
Q
;
;=======================================================================
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
Q
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
