PXRMP26I ;SLC/PKR - Inits for PXRM*2.0*26. ;05/07/2014
;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
Q
;==========================================
CFINC(Y) ;List of computed findings to include in the build.
N CFLIST,CFNAME
S CFLIST("VA-ALLERGY")=""
S CFLIST("VA-FILEMAN DATE")=""
S CFLIST("VA-PROGRESS NOTE")=""
S CFLIST("VA-REMINDER DEFINITION")=""
;S CFLIST("")=""
S CFNAME=$P($G(^PXRMD(811.4,Y,0)),U)
Q $S($D(CFLIST(CFNAME)):1,1:0)
;
;==========================================
CHECK(GLOB,DLGPTR) ; check for duplicates
N INDEX,RETURN S INDEX=0,RESULT=1
;RESULT=1 ok to add, RESULT=-1 not ok to add
F S INDEX=$O(@GLOB@(INDEX)) Q:INDEX=""!(RESULT=-1) D
.S:DLGPTR=$P(@GLOB@(INDEX),U) RESULT=-1 ;if the pointer matches one of the prompts already stored, it's a duplicate, don't store it again.
Q RESULT
;
;==================================================
CTAXBDES ;Copy taxonomy brief descriptions to the description field.
N BDES,IEN,NAME
D BMES^XPDUTL("Copying all taxonomy Brief Descriptions to Description.")
S NAME=""
F S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME="" D
. S IEN=$O(^PXD(811.2,"B",NAME,""))
. S BDES=$P(^PXD(811.2,IEN,0),U,2)
. D BMES^XPDUTL("Working on taxonomy "_NAME)
. I BDES="" D MES^XPDUTL(" Brief description does not exist.") Q
. I $D(^PXD(811.2,IEN,1)) D MES^XPDUTL(" Already copied.") Q
. D MES^XPDUTL(" Brief description: "_BDES)
. S ^PXD(811.2,IEN,1,0)="^^1^1^"_DT_"^^"
. S ^PXD(811.2,IEN,1,1,0)=BDES
Q
;
;==========================================
DELDD ;Delete the old data dictionaries.
N DIU,TEXT
D EN^DDIOL("Removing old data dictionaries.")
S DIU(0)=""
F DIU=811.2,801.41 D
. S TEXT=" Deleting data dictionary for file # "_DIU
. D EN^DDIOL(TEXT)
. D EN^DIU2
Q
;
;==========================================
DELOPT ;AGP ICD10: added code to remove options from menu.
N RESULT
;Remove PXRM TAXONOMY DIALOG from PXRM DIALOG PARAMETERS also set the
;PXRM TAXONOMY DIALOG to delete in the build file.
S RESULT=$$DELETE^XPDMENU("PXRM DIALOG PARAMETERS","PXRM TAXONOMY DIALOG")
Q
;
;===============================================
DEXXREFS ;Delete unused Exchange Installation History 'B' indexes.
N MSG
;Component List
D DELIX^DDMOD(811.8031,.01,1,"K","","MSG")
;Additional Details
D DELIX^DDMOD(811.80315,.01,1,"K","","MSG")
Q
;
;===============================================
INILT ;Initialize list templates
;THIS MAY NO LONGER BE NECESSARY, THIS NEEDS TO BE CONFIRMED
;N IEN,IND,LIST,TEMP0
;D LTL^PXRMP26I(.LIST)
;S IND=0
;IA #4123
;F S IND=$O(LIST(IND)) Q:IND="" D
;. S IEN=$O(^SD(409.61,"B",LIST(IND),"")) Q:IEN=""
;. S TEMP0=$G(^SD(409.61,IEN,0))
;. K ^SD(409.61,IEN)
;. S ^SD(409.61,IEN,0)=TEMP0
Q
;
;==========================================
LTL(LIST) ;This is the list of list templates that being distributed
;in the patch.
;S LIST(1)="PXRM EX LIST COMPONENTS"
;S LIST(2)="PXRM EX REMINDER EXCHANGE"
Q
;
;==========================================
PRE ;Pre-init
;Disable options and protocols
D OPTION^PXRMUTIL("DISABLE")
D PROTOCOL^PXRMUTIL("DISABLE")
D BUILDD^PXRMDIEV("PXRM*2.0*26")
D DELOPT
D TMGRRO^PXRMP26I
D PRE^PXRMP26D
D DELDD^PXRMP26I
D DELEXE^PXRMEXSI("EXARRAY","PXRMP26E")
Q
;
;==========================================
POST ;Post-init
D TMGRN^PXRMP26I
D CTAXBDES^PXRMP26I
D CPALL^PXRMTXCR
D SETPVER^PXRMUTIL("2.0P26")
D POST^PXRMP26D
D DEXXREFS^PXRMP26I
;Install Exchange File entries.
D SMEXINS^PXRMEXSI("EXARRAY","PXRMP26E")
D RBLD20I^PXRMTAXD
D RBPDS^PXRMP26I
;Check the Selected Codes Multiple and repair any that are corrupted.
D CHECKALL^PXRMTXIC
;Enable options and protocols
D OPTION^PXRMUTIL("ENABLE")
D PROTOCOL^PXRMUTIL("ENABLE")
D BUILDE^PXRMDIEV("PXRM*2.0*26")
;If the indexes for files #45 and #9000011 are still rebuilding,
;disable reminder evaluation.
I '$D(^PXRMINDX(45,"DATE BUILT")) D INDEXD^PXRMDIEV(45)
I '$D(^PXRMINDX(9000011,"DATE BUILT")) D INDEXD^PXRMDIEV(9000011)
;Put the old taxonomy management and edit options out of order.
D OUT^XPDMENU("PXRM TAXONOMY MANAGEMENT (OLD)","This option is obsolete.")
D OUT^XPDMENU("PXRM TAXONOMY EDIT","This option is obsolete.")
D OUT^XPDMENU("PXRMCS INACTIVE DIALOG CODES","This option is obsolete.")
D SENDIM^PXRMP26I
Q
;
;==========================================
RBPDS ;Rebuild the Patient Data Source index.
N IEN,NAME,PDS
D BMES^XPDUTL("Rebuilding Patient Data Source Index.")
S NAME=""
F S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME="" D
. S IEN=$O(^PXD(811.2,"B",NAME,""))
. S PDS=$P(^PXD(811.2,IEN,0),U,4)
. D MES^XPDUTL(" Taxonomy: "_NAME_"; IEN="_IEN_"; PDS="_PDS)
. D SPDS^PXRMPDS(IEN,PDS)
Q
;
;==========================================
SENDIM ;Send install message.
N FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
S NODE="PXRM*2.0*26"
K ^TMP(NODE,$J)
;DBIA #1131 for ^XMB("NETNAME")
S FROM="PXRM*2.0*26 Install@"_^XMB("NETNAME")
;DBIA #2541
S SYSTEM=$$KSP^XUPARAM("WHERE")
I $$PROD^XUPROD(1) S TO("G.CLINICAL REMINDERS SUPPORT@DOMAIN.EXT")=""
E D
. N MGIEN,MGROUP
. S MGIEN=$G(^PXRM(800,1,"MGFE"))
. S MGROUP=$S(MGIEN'="":"G."_$$GET1^DIQ(3.8,MGIEN,.01),1:DUZ)
. S TO(MGROUP)=""
S SUBJECT="Install of PXRM*2.0*26"
S ^TMP(NODE,$J,1,0)="PXRM*2.0*26 has been installed."
S ^TMP(NODE,$J,2,0)="System is "_SYSTEM
D SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
Q
;
;===============================================
TMGRN ;Replace the old taxonomy mangement option with the new one on the
;PXRM MANAGERS MENU.
N RESULT
S RESULT=$$DELETE^XPDMENU("PXRM MANAGERS MENU","PXRM TAXONOMY MANAGEMENT (OLD)")
S RESULT=$$ADD^XPDMENU("PXRM MANAGERS MENU","PXRM TAXONOMY MANAGEMENT","TXM",20)
Q
;
;===============================================
TMGRRO ;Handle the old PXRM TAXONOMY MANAGEMENT option. Do not delete it until
;the cleanup patch, rename it for now. If the rename has already been
;done, don't do it again.
I +$$LKOPT^XPDMENU("PXRM TAXONOMY MANAGEMENT (OLD)")>0 Q
D BMES^XPDUTL("Setting up taxonomy management option.")
D RENAME^XPDMENU("PXRM TAXONOMY MANAGEMENT","PXRM TAXONOMY MANAGEMENT (OLD)")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP26I 6270 printed Apr 09, 2024@20:53:42 Page 2
PXRMP26I ;SLC/PKR - Inits for PXRM*2.0*26. ;05/07/2014
+1 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
+2 QUIT
+3 ;==========================================
CFINC(Y) ;List of computed findings to include in the build.
+1 NEW CFLIST,CFNAME
+2 SET CFLIST("VA-ALLERGY")=""
+3 SET CFLIST("VA-FILEMAN DATE")=""
+4 SET CFLIST("VA-PROGRESS NOTE")=""
+5 SET CFLIST("VA-REMINDER DEFINITION")=""
+6 ;S CFLIST("")=""
+7 SET CFNAME=$PIECE($GET(^PXRMD(811.4,Y,0)),U)
+8 QUIT $SELECT($DATA(CFLIST(CFNAME)):1,1:0)
+9 ;
+10 ;==========================================
CHECK(GLOB,DLGPTR) ; check for duplicates
+1 NEW INDEX,RETURN
SET INDEX=0
SET RESULT=1
+2 ;RESULT=1 ok to add, RESULT=-1 not ok to add
+3 FOR
SET INDEX=$ORDER(@GLOB@(INDEX))
if INDEX=""!(RESULT=-1)
QUIT
Begin DoDot:1
+4 ;if the pointer matches one of the prompts already stored, it's a duplicate, don't store it again.
if DLGPTR=$PIECE(@GLOB@(INDEX),U)
SET RESULT=-1
End DoDot:1
+5 QUIT RESULT
+6 ;
+7 ;==================================================
CTAXBDES ;Copy taxonomy brief descriptions to the description field.
+1 NEW BDES,IEN,NAME
+2 DO BMES^XPDUTL("Copying all taxonomy Brief Descriptions to Description.")
+3 SET NAME=""
+4 FOR
SET NAME=$ORDER(^PXD(811.2,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 SET IEN=$ORDER(^PXD(811.2,"B",NAME,""))
+6 SET BDES=$PIECE(^PXD(811.2,IEN,0),U,2)
+7 DO BMES^XPDUTL("Working on taxonomy "_NAME)
+8 IF BDES=""
DO MES^XPDUTL(" Brief description does not exist.")
QUIT
+9 IF $DATA(^PXD(811.2,IEN,1))
DO MES^XPDUTL(" Already copied.")
QUIT
+10 DO MES^XPDUTL(" Brief description: "_BDES)
+11 SET ^PXD(811.2,IEN,1,0)="^^1^1^"_DT_"^^"
+12 SET ^PXD(811.2,IEN,1,1,0)=BDES
End DoDot:1
+13 QUIT
+14 ;
+15 ;==========================================
DELDD ;Delete the old data dictionaries.
+1 NEW DIU,TEXT
+2 DO EN^DDIOL("Removing old data dictionaries.")
+3 SET DIU(0)=""
+4 FOR DIU=811.2,801.41
Begin DoDot:1
+5 SET TEXT=" Deleting data dictionary for file # "_DIU
+6 DO EN^DDIOL(TEXT)
+7 DO EN^DIU2
End DoDot:1
+8 QUIT
+9 ;
+10 ;==========================================
DELOPT ;AGP ICD10: added code to remove options from menu.
+1 NEW RESULT
+2 ;Remove PXRM TAXONOMY DIALOG from PXRM DIALOG PARAMETERS also set the
+3 ;PXRM TAXONOMY DIALOG to delete in the build file.
+4 SET RESULT=$$DELETE^XPDMENU("PXRM DIALOG PARAMETERS","PXRM TAXONOMY DIALOG")
+5 QUIT
+6 ;
+7 ;===============================================
DEXXREFS ;Delete unused Exchange Installation History 'B' indexes.
+1 NEW MSG
+2 ;Component List
+3 DO DELIX^DDMOD(811.8031,.01,1,"K","","MSG")
+4 ;Additional Details
+5 DO DELIX^DDMOD(811.80315,.01,1,"K","","MSG")
+6 QUIT
+7 ;
+8 ;===============================================
INILT ;Initialize list templates
+1 ;THIS MAY NO LONGER BE NECESSARY, THIS NEEDS TO BE CONFIRMED
+2 ;N IEN,IND,LIST,TEMP0
+3 ;D LTL^PXRMP26I(.LIST)
+4 ;S IND=0
+5 ;IA #4123
+6 ;F S IND=$O(LIST(IND)) Q:IND="" D
+7 ;. S IEN=$O(^SD(409.61,"B",LIST(IND),"")) Q:IEN=""
+8 ;. S TEMP0=$G(^SD(409.61,IEN,0))
+9 ;. K ^SD(409.61,IEN)
+10 ;. S ^SD(409.61,IEN,0)=TEMP0
+11 QUIT
+12 ;
+13 ;==========================================
LTL(LIST) ;This is the list of list templates that being distributed
+1 ;in the patch.
+2 ;S LIST(1)="PXRM EX LIST COMPONENTS"
+3 ;S LIST(2)="PXRM EX REMINDER EXCHANGE"
+4 QUIT
+5 ;
+6 ;==========================================
PRE ;Pre-init
+1 ;Disable options and protocols
+2 DO OPTION^PXRMUTIL("DISABLE")
+3 DO PROTOCOL^PXRMUTIL("DISABLE")
+4 DO BUILDD^PXRMDIEV("PXRM*2.0*26")
+5 DO DELOPT
+6 DO TMGRRO^PXRMP26I
+7 DO PRE^PXRMP26D
+8 DO DELDD^PXRMP26I
+9 DO DELEXE^PXRMEXSI("EXARRAY","PXRMP26E")
+10 QUIT
+11 ;
+12 ;==========================================
POST ;Post-init
+1 DO TMGRN^PXRMP26I
+2 DO CTAXBDES^PXRMP26I
+3 DO CPALL^PXRMTXCR
+4 DO SETPVER^PXRMUTIL("2.0P26")
+5 DO POST^PXRMP26D
+6 DO DEXXREFS^PXRMP26I
+7 ;Install Exchange File entries.
+8 DO SMEXINS^PXRMEXSI("EXARRAY","PXRMP26E")
+9 DO RBLD20I^PXRMTAXD
+10 DO RBPDS^PXRMP26I
+11 ;Check the Selected Codes Multiple and repair any that are corrupted.
+12 DO CHECKALL^PXRMTXIC
+13 ;Enable options and protocols
+14 DO OPTION^PXRMUTIL("ENABLE")
+15 DO PROTOCOL^PXRMUTIL("ENABLE")
+16 DO BUILDE^PXRMDIEV("PXRM*2.0*26")
+17 ;If the indexes for files #45 and #9000011 are still rebuilding,
+18 ;disable reminder evaluation.
+19 IF '$DATA(^PXRMINDX(45,"DATE BUILT"))
DO INDEXD^PXRMDIEV(45)
+20 IF '$DATA(^PXRMINDX(9000011,"DATE BUILT"))
DO INDEXD^PXRMDIEV(9000011)
+21 ;Put the old taxonomy management and edit options out of order.
+22 DO OUT^XPDMENU("PXRM TAXONOMY MANAGEMENT (OLD)","This option is obsolete.")
+23 DO OUT^XPDMENU("PXRM TAXONOMY EDIT","This option is obsolete.")
+24 DO OUT^XPDMENU("PXRMCS INACTIVE DIALOG CODES","This option is obsolete.")
+25 DO SENDIM^PXRMP26I
+26 QUIT
+27 ;
+28 ;==========================================
RBPDS ;Rebuild the Patient Data Source index.
+1 NEW IEN,NAME,PDS
+2 DO BMES^XPDUTL("Rebuilding Patient Data Source Index.")
+3 SET NAME=""
+4 FOR
SET NAME=$ORDER(^PXD(811.2,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 SET IEN=$ORDER(^PXD(811.2,"B",NAME,""))
+6 SET PDS=$PIECE(^PXD(811.2,IEN,0),U,4)
+7 DO MES^XPDUTL(" Taxonomy: "_NAME_"; IEN="_IEN_"; PDS="_PDS)
+8 DO SPDS^PXRMPDS(IEN,PDS)
End DoDot:1
+9 QUIT
+10 ;
+11 ;==========================================
SENDIM ;Send install message.
+1 NEW FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
+2 SET NODE="PXRM*2.0*26"
+3 KILL ^TMP(NODE,$JOB)
+4 ;DBIA #1131 for ^XMB("NETNAME")
+5 SET FROM="PXRM*2.0*26 Install@"_^XMB("NETNAME")
+6 ;DBIA #2541
+7 SET SYSTEM=$$KSP^XUPARAM("WHERE")
+8 IF $$PROD^XUPROD(1)
SET TO("G.CLINICAL REMINDERS SUPPORT@DOMAIN.EXT")=""
+9 IF '$TEST
Begin DoDot:1
+10 NEW MGIEN,MGROUP
+11 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+12 SET MGROUP=$SELECT(MGIEN'="":"G."_$$GET1^DIQ(3.8,MGIEN,.01),1:DUZ)
+13 SET TO(MGROUP)=""
End DoDot:1
+14 SET SUBJECT="Install of PXRM*2.0*26"
+15 SET ^TMP(NODE,$JOB,1,0)="PXRM*2.0*26 has been installed."
+16 SET ^TMP(NODE,$JOB,2,0)="System is "_SYSTEM
+17 DO SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
+18 QUIT
+19 ;
+20 ;===============================================
TMGRN ;Replace the old taxonomy mangement option with the new one on the
+1 ;PXRM MANAGERS MENU.
+2 NEW RESULT
+3 SET RESULT=$$DELETE^XPDMENU("PXRM MANAGERS MENU","PXRM TAXONOMY MANAGEMENT (OLD)")
+4 SET RESULT=$$ADD^XPDMENU("PXRM MANAGERS MENU","PXRM TAXONOMY MANAGEMENT","TXM",20)
+5 QUIT
+6 ;
+7 ;===============================================
TMGRRO ;Handle the old PXRM TAXONOMY MANAGEMENT option. Do not delete it until
+1 ;the cleanup patch, rename it for now. If the rename has already been
+2 ;done, don't do it again.
+3 IF +$$LKOPT^XPDMENU("PXRM TAXONOMY MANAGEMENT (OLD)")>0
QUIT
+4 DO BMES^XPDUTL("Setting up taxonomy management option.")
+5 DO RENAME^XPDMENU("PXRM TAXONOMY MANAGEMENT","PXRM TAXONOMY MANAGEMENT (OLD)")
+6 QUIT
+7 ;
