PXRMP6I ; SLC/PKR - Inits for PXRM*2.0*6 ;11/25/2007
;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
Q
;====================================================
DELDD ;Delete the old data dictionaries.
N DIU,TEXT
D EN^DDIOL("Removing old data dictionaries.")
S DIU(0)=""
F DIU=800,801.41,810.1,810.2,810.4,810.5,810.8,811.5,811.8,811.9 D
. S TEXT=" Deleting data dictionary for file # "_DIU
. D EN^DDIOL(TEXT)
. D EN^DIU2
Q
;
;====================================================
LISTRULE(IEN) ;List of list rules to include in the build.
N NAME,OK
S OK=0
S NAME=$P(^PXRM(810.4,IEN,0),U,1)
I NAME="VA-*IHD QUERI 412 DIAGNOSIS" S OK=1
I NAME="VA-*IHD QUERI ANCHOR VISIT" S OK=1
I NAME="VA-*IHD QUERI LIPID LOWERING MEDS" S OK=1
I NAME="VA-*IHD QUERI PTS WITH QUALIFY VISIT" S OK=1
I NAME="VA-*MH QUERI QUALIFY MH VISIT" S OK=1
I NAME="VA-*MH QUERI QUALIFY PC VISIT" S OK=1
I OK D RMEHIST^PXRMUTIL(810.4,IEN)
Q OK
;
;====================================================
OPTION(ACTION) ;Disable/enable options.
N ACT,IND,OPT,LIST,RESULT
S ACT=$S(ACTION=2:"DISABLE",ACTION=1:"ENABLE",1:"?")
D BMES^XPDUTL(ACT_" options.")
;
D FIND^DIC(19,"","@;.01","","GMTS","*","B","","","LIST")
F IND=1:1:+LIST("DILIST",0) D
. S OPT=LIST("DILIST","ID",IND,.01)
S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
I RESULT=0 D MES^XPDUTL("Could not "_ACT_" option "_OPT)
;
K LIST
D FIND^DIC(19,"","@;.01","","IBDF PRINT","*","B","","","LIST")
F IND=1:1:+LIST("DILIST",0) D
. S OPT=LIST("DILIST","ID",IND,.01)
. S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
. I RESULT=0 D MES^XPDUTL("Could not "_ACT_" option "_OPT)
;
S OPT="OR CPRS GUI CHART"
S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
I RESULT=0 D MES^XPDUTL("Could not "_ACT_" option "_OPT)
;
S OPT="ORS HEALTH SUMMARY"
S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
I RESULT=0 D MES^XPDUTL("Could not "_ACT_" option "_OPT)
;
K LIST
D FIND^DIC(19,"","@;.01","","PXRM","*","B","","","LIST")
F IND=1:1:+LIST("DILIST",0) D
. S OPT=LIST("DILIST","ID",IND,.01)
. S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
. I RESULT=0 W !,"Could not ",ACTION," option ",OPT
Q
;
;====================================================
PRE ;These are the pre-installation actions
D ENVCHK^PXRMP6IM I $G(XPDABORT)=1 Q
;Disable options and protocols
D OPTION(2)
D PROTOCOL(2)
;Delete existing exchange file entries.
D DELEXI^PXRMP6IE
;Rename entries that need it.
D RENAME
;Initialize list template.
D INILT^PXRMP6IL
;Delete the old DDs.
D DELDD
;Repoint dialog with BDI as a finding item to BDI2
D BDICONV^PXRMP6ID
D CHECKRG^PXRMP6ID
D STORERG^PXRMP6ID
Q
;
;====================================================
POST ;These are the post-installation actions
N NLINES
D SETMAXMH
;Convert the mental health pointers.
D HMHPTRS^PXRMP6IM(.NLINES,1)
;Convert Conditions for mental health findings.
D MHCOND^PXRMP6IC
I '$D(^PXRMINDX(601.84,"DATE BUILT")) S ^PXRMINDX(601.84,"DATE BUILT")=$$NOW^XLFDT
;Convert the rule set sequences to numbers.
D SEQCONV^PXRMP6IS
;Enable options and protocols
D OPTION(1)
D PROTOCOL(1)
D SMEXINS^PXRMP6IE
D RTAXEXP
D WRITERG^PXRMP6ID
D DCLEAN^PXRMP6ID
D REINDEX^PXRMP6ID
D RESCIND
Q
;
;====================================================
PROTOCOL(ACTION) ;Disable/enable protocols.
N ACT,PROT,RESULT
S ACT=$S(ACTION=2:"DISABLE",ACTION=1:"ENABLE",1:"?")
D BMES^XPDUTL(ACT_" protocols.")
;
S PROT="ORS HEALTH SUMMARY"
S RESULT=$$PRODE^XPDUTL(PROT,ACTION)
I RESULT=0 D MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
;
S PROT="ORS AD HOC HEALTH SUMMARY"
S RESULT=$$PRODE^XPDUTL(PROT,ACTION)
I RESULT=0 D MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
;
S PROT="PXRM PATIENT DATA CHANGE"
S RESULT=$$PRODE^XPDUTL(PROT,ACTION)
I RESULT=0 D MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
Q
;
;====================================================
RESCIND ;
N ARY,NAME,IEN,TEXT
S TEXT(1)="Rescinding outdated National Reminder and disabling outdated"
S TEXT(2)="National Reminder Dialog"
S TEXT(3)=""
D BMES^XPDUTL(.TEXT)
S NAME="VA-POS DEPRESSION SCREEN FOLLOWUP"
S IEN=$O(^PXD(811.9,"B",NAME,"")) Q:IEN'>0
K ARY
;S ARY(1,811.9,IEN_",",1.6)=1
S ARY(1,811.9,IEN_",",69)=3071101
D FILE^DIE("","ARY(1)")
S TEXT(1)="Rescinding reminder: "_NAME
S TEXT(2)=""
D BMES^XPDUTL(.TEXT)
S DIEN=$G(^PXD(811.9,IEN,51)) Q:DIEN'>0
S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
K ARY
S ARY(1,801.41,DIEN_",",3)="Disable with PXRM*2.0*6 on Nov 1, 2007"
D FILE^DIE("","ARY(1)")
S TEXT(1)="Disabling Dialog: "_NAME
D BMES^XPDUTL(.TEXT)
Q
;====================================================
RENAME ;Rename entries
N DA,DIE
S DA=+$O(^PXRM(810.4,"B","VA-*MH QUERY QUALIFYING MH VISIT",""))
I DA=0 Q
S DIE=810.4,DR=".01///VA-*MH QUERI QUALIFYING MH VISIT"
D ^DIE
Q
;
;====================================================
RTAXEXP ;Rebuild taxonomy expansions.
N IEN,IND,TEXT,TNAME
S TNAME(1)="VA-TETANUS DIPHTHERIA"
S TNAME(2)="VA-WH HYSTERECTOMY W/CERVIX REMOVED"
D BMES^XPDUTL("Rebuilding taxonomy expansions.")
F IND=1:1:2 D
. S IEN=$O(^PXD(811.2,"B",TNAME(IND),""))
. I IEN="" Q
. S TEXT=" Working on taxonomy "_IEN
. D BMES^XPDUTL(TEXT)
. D DELEXTL^PXRMBXTL(IEN)
. D EXPAND^PXRMBXTL(IEN,"")
Q
;
;====================================================
SETMAXMH ;Set the maximum number of mental health questions that can be
;administered through a reminder dialog.
N DA,DIE,DR
I +$P($G(^PXRM(800,1,"MH")),U)>0 Q
S DA=1,DR="17////35",DIE="^PXRM(800," D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP6I 5661 printed Dec 13, 2024@01:48:06 Page 2
PXRMP6I ; SLC/PKR - Inits for PXRM*2.0*6 ;11/25/2007
+1 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+2 QUIT
+3 ;====================================================
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=800,801.41,810.1,810.2,810.4,810.5,810.8,811.5,811.8,811.9
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 ;====================================================
LISTRULE(IEN) ;List of list rules to include in the build.
+1 NEW NAME,OK
+2 SET OK=0
+3 SET NAME=$PIECE(^PXRM(810.4,IEN,0),U,1)
+4 IF NAME="VA-*IHD QUERI 412 DIAGNOSIS"
SET OK=1
+5 IF NAME="VA-*IHD QUERI ANCHOR VISIT"
SET OK=1
+6 IF NAME="VA-*IHD QUERI LIPID LOWERING MEDS"
SET OK=1
+7 IF NAME="VA-*IHD QUERI PTS WITH QUALIFY VISIT"
SET OK=1
+8 IF NAME="VA-*MH QUERI QUALIFY MH VISIT"
SET OK=1
+9 IF NAME="VA-*MH QUERI QUALIFY PC VISIT"
SET OK=1
+10 IF OK
DO RMEHIST^PXRMUTIL(810.4,IEN)
+11 QUIT OK
+12 ;
+13 ;====================================================
OPTION(ACTION) ;Disable/enable options.
+1 NEW ACT,IND,OPT,LIST,RESULT
+2 SET ACT=$SELECT(ACTION=2:"DISABLE",ACTION=1:"ENABLE",1:"?")
+3 DO BMES^XPDUTL(ACT_" options.")
+4 ;
+5 DO FIND^DIC(19,"","@;.01","","GMTS","*","B","","","LIST")
+6 FOR IND=1:1:+LIST("DILIST",0)
Begin DoDot:1
+7 SET OPT=LIST("DILIST","ID",IND,.01)
End DoDot:1
+8 SET RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
+9 IF RESULT=0
DO MES^XPDUTL("Could not "_ACT_" option "_OPT)
+10 ;
+11 KILL LIST
+12 DO FIND^DIC(19,"","@;.01","","IBDF PRINT","*","B","","","LIST")
+13 FOR IND=1:1:+LIST("DILIST",0)
Begin DoDot:1
+14 SET OPT=LIST("DILIST","ID",IND,.01)
+15 SET RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
+16 IF RESULT=0
DO MES^XPDUTL("Could not "_ACT_" option "_OPT)
End DoDot:1
+17 ;
+18 SET OPT="OR CPRS GUI CHART"
+19 SET RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
+20 IF RESULT=0
DO MES^XPDUTL("Could not "_ACT_" option "_OPT)
+21 ;
+22 SET OPT="ORS HEALTH SUMMARY"
+23 SET RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
+24 IF RESULT=0
DO MES^XPDUTL("Could not "_ACT_" option "_OPT)
+25 ;
+26 KILL LIST
+27 DO FIND^DIC(19,"","@;.01","","PXRM","*","B","","","LIST")
+28 FOR IND=1:1:+LIST("DILIST",0)
Begin DoDot:1
+29 SET OPT=LIST("DILIST","ID",IND,.01)
+30 SET RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
+31 IF RESULT=0
WRITE !,"Could not ",ACTION," option ",OPT
End DoDot:1
+32 QUIT
+33 ;
+34 ;====================================================
PRE ;These are the pre-installation actions
+1 DO ENVCHK^PXRMP6IM
IF $GET(XPDABORT)=1
QUIT
+2 ;Disable options and protocols
+3 DO OPTION(2)
+4 DO PROTOCOL(2)
+5 ;Delete existing exchange file entries.
+6 DO DELEXI^PXRMP6IE
+7 ;Rename entries that need it.
+8 DO RENAME
+9 ;Initialize list template.
+10 DO INILT^PXRMP6IL
+11 ;Delete the old DDs.
+12 DO DELDD
+13 ;Repoint dialog with BDI as a finding item to BDI2
+14 DO BDICONV^PXRMP6ID
+15 DO CHECKRG^PXRMP6ID
+16 DO STORERG^PXRMP6ID
+17 QUIT
+18 ;
+19 ;====================================================
POST ;These are the post-installation actions
+1 NEW NLINES
+2 DO SETMAXMH
+3 ;Convert the mental health pointers.
+4 DO HMHPTRS^PXRMP6IM(.NLINES,1)
+5 ;Convert Conditions for mental health findings.
+6 DO MHCOND^PXRMP6IC
+7 IF '$DATA(^PXRMINDX(601.84,"DATE BUILT"))
SET ^PXRMINDX(601.84,"DATE BUILT")=$$NOW^XLFDT
+8 ;Convert the rule set sequences to numbers.
+9 DO SEQCONV^PXRMP6IS
+10 ;Enable options and protocols
+11 DO OPTION(1)
+12 DO PROTOCOL(1)
+13 DO SMEXINS^PXRMP6IE
+14 DO RTAXEXP
+15 DO WRITERG^PXRMP6ID
+16 DO DCLEAN^PXRMP6ID
+17 DO REINDEX^PXRMP6ID
+18 DO RESCIND
+19 QUIT
+20 ;
+21 ;====================================================
PROTOCOL(ACTION) ;Disable/enable protocols.
+1 NEW ACT,PROT,RESULT
+2 SET ACT=$SELECT(ACTION=2:"DISABLE",ACTION=1:"ENABLE",1:"?")
+3 DO BMES^XPDUTL(ACT_" protocols.")
+4 ;
+5 SET PROT="ORS HEALTH SUMMARY"
+6 SET RESULT=$$PRODE^XPDUTL(PROT,ACTION)
+7 IF RESULT=0
DO MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
+8 ;
+9 SET PROT="ORS AD HOC HEALTH SUMMARY"
+10 SET RESULT=$$PRODE^XPDUTL(PROT,ACTION)
+11 IF RESULT=0
DO MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
+12 ;
+13 SET PROT="PXRM PATIENT DATA CHANGE"
+14 SET RESULT=$$PRODE^XPDUTL(PROT,ACTION)
+15 IF RESULT=0
DO MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
+16 QUIT
+17 ;
+18 ;====================================================
RESCIND ;
+1 NEW ARY,NAME,IEN,TEXT
+2 SET TEXT(1)="Rescinding outdated National Reminder and disabling outdated"
+3 SET TEXT(2)="National Reminder Dialog"
+4 SET TEXT(3)=""
+5 DO BMES^XPDUTL(.TEXT)
+6 SET NAME="VA-POS DEPRESSION SCREEN FOLLOWUP"
+7 SET IEN=$ORDER(^PXD(811.9,"B",NAME,""))
if IEN'>0
QUIT
+8 KILL ARY
+9 ;S ARY(1,811.9,IEN_",",1.6)=1
+10 SET ARY(1,811.9,IEN_",",69)=3071101
+11 DO FILE^DIE("","ARY(1)")
+12 SET TEXT(1)="Rescinding reminder: "_NAME
+13 SET TEXT(2)=""
+14 DO BMES^XPDUTL(.TEXT)
+15 SET DIEN=$GET(^PXD(811.9,IEN,51))
if DIEN'>0
QUIT
+16 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+17 KILL ARY
+18 SET ARY(1,801.41,DIEN_",",3)="Disable with PXRM*2.0*6 on Nov 1, 2007"
+19 DO FILE^DIE("","ARY(1)")
+20 SET TEXT(1)="Disabling Dialog: "_NAME
+21 DO BMES^XPDUTL(.TEXT)
+22 QUIT
+23 ;====================================================
RENAME ;Rename entries
+1 NEW DA,DIE
+2 SET DA=+$ORDER(^PXRM(810.4,"B","VA-*MH QUERY QUALIFYING MH VISIT",""))
+3 IF DA=0
QUIT
+4 SET DIE=810.4
SET DR=".01///VA-*MH QUERI QUALIFYING MH VISIT"
+5 DO ^DIE
+6 QUIT
+7 ;
+8 ;====================================================
RTAXEXP ;Rebuild taxonomy expansions.
+1 NEW IEN,IND,TEXT,TNAME
+2 SET TNAME(1)="VA-TETANUS DIPHTHERIA"
+3 SET TNAME(2)="VA-WH HYSTERECTOMY W/CERVIX REMOVED"
+4 DO BMES^XPDUTL("Rebuilding taxonomy expansions.")
+5 FOR IND=1:1:2
Begin DoDot:1
+6 SET IEN=$ORDER(^PXD(811.2,"B",TNAME(IND),""))
+7 IF IEN=""
QUIT
+8 SET TEXT=" Working on taxonomy "_IEN
+9 DO BMES^XPDUTL(TEXT)
+10 DO DELEXTL^PXRMBXTL(IEN)
+11 DO EXPAND^PXRMBXTL(IEN,"")
End DoDot:1
+12 QUIT
+13 ;
+14 ;====================================================
SETMAXMH ;Set the maximum number of mental health questions that can be
+1 ;administered through a reminder dialog.
+2 NEW DA,DIE,DR
+3 IF +$PIECE($GET(^PXRM(800,1,"MH")),U)>0
QUIT
+4 SET DA=1
SET DR="17////35"
SET DIE="^PXRM(800,"
DO ^DIE
+5 QUIT
+6 ;
