PXRMP17I ; SLC/PKR - Inits for PXRM*2.0*17. ;02/02/2010
;;2.0;CLINICAL REMINDERS;**17**;Feb 04, 2005;Build 102
Q
;==========================================
ALLERGY ;Reset computed finding parameter for new version of VA-ALLERGY
;computed finding.
D BMES^XPDUTL("Reset computed finding parameter for new version of VA-ALLERGY")
N CFIEN,CFPARAM,IEN,FINDING
S CFIEN=$O(^PXRMD(811.4,"B","VA-ALLERGY",""))
I CFIEN="" Q
K ^TMP($J,"LIST")
D BLDLIST^PXRMFRPT(811.4,"PXRMD(811.4,",CFIEN,"LIST")
;Process definitions
S IEN=""
F S IEN=$O(^TMP($J,"LIST",811.4,CFIEN,"DEF",IEN)) Q:IEN="" D
. S FINDING=""
. F S FINDING=$O(^TMP($J,"LIST",811.4,CFIEN,"DEF",IEN,FINDING)) Q:FINDING="" D
.. S CFPARAM=$G(^PXD(811.9,IEN,20,FINDING,15)) Q:$L(CFPARAM,":")'=2 ;already converted if not equal to 2
.. S ^PXD(811.9,IEN,20,FINDING,15)=CFPARAM_":*:*:*" ;add 3 new parameters
;Process terms
S IEN=""
F S IEN=$O(^TMP($J,"LIST",811.4,CFIEN,"TERM",IEN)) Q:IEN="" D
. S FINDING=""
. F S FINDING=$O(^TMP($J,"LIST",811.4,CFIEN,"TERM",IEN,FINDING)) Q:FINDING="" D
.. S CFPARAM=$G(^PXRMD(811.5,IEN,20,FINDING,15)) Q:$L(CFPARAM,":")'=2 ;already converted if not equal to 2
.. S ^PXRMD(811.5,IEN,20,FINDING,15)=CFPARAM_":*:*:*" ;add 3 new parameters
K ^TMP($J,"LIST")
Q
;
;===============================================================
CFINC(Y) ;List of computed findings to include in the build.
N CFLIST,CFNAME
S CFLIST("VA-ALLERGY")=""
S CFLIST("VA-ASU USER CLASS")=""
S CFLIST("VA-WAS INPATIENT")=""
S CFLIST("VA-ACTIVE PATIENT RECORD FLAGS")=""
S CFNAME=$P($G(^PXRMD(811.4,Y,0)),U)
Q $S($D(CFLIST(CFNAME)):1,1:0)
;
;===============================================================
DELDD ;Delete the old data dictionaries.
;N DIU,TEXT
;D EN^DDIOL("Removing old data dictionaries.")
;S DIU(0)=""
;F DIU=801.41,810.1,810.2,810.4,810.5,810.7,810.8,810.9,811.2,811.4,811.5,811.6,811.8,811.9 D
;. S TEXT=" Deleting data dictionary for file # "_DIU
;. D EN^DDIOL(TEXT)
;. D EN^DIU2
Q
;
;==========================================
INILT ;Initialize list templates
;N IEN,IND,LIST,TEMP0
;D LTL^PXRMP12I(.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
;
;===============================================================
MSTSYNC ;Run the MST synchronization.
N TEXT
K ZTSAVE
S ZTSAVE("STIME")=-1
S ZTRTN="SYNCH^PXRMMST"
S ZTDESC="Clinical Reminders MST synchronization job"
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
D ^%ZTLOAD
S TEXT="MST synchronization queued, task number "_$G(ZTSK)_"."
D BMES^XPDUTL(.TEXT)
Q
;
;===============================================================
PRE ;Pre-init
;Disable options and protocols
D OPTION^PXRMUTIL("DISABLE")
D PROTOCOL^PXRMUTIL("DISABLE")
D DELEXE^PXRMEXSI("EXARRAY","PXRMP17E")
Q
;
;===============================================================
POST ;Post-init
;Enable options and protocols
D OPTION^PXRMUTIL("ENABLE")
D PROTOCOL^PXRMUTIL("ENABLE")
D RENASPON^PXRMP17I
D SENDPV^PXRMP17I
;Install Exchange File entries.
D SMEXINS^PXRMEXSI("EXARRAY","PXRMP17E")
;Run the MST synchronization.
D MSTSYNC^PXRMP17I
;Reset computed finding parameter for new version of VA-ALLERGY.
D ALLERGY^PXRMP17U
D SETPVER^PXRMUTIL("2.0P17")
Q
;
;===============================================================
RENASPON ;Rename some Sponsor file entries.
N OLDNAME,NEWNAME
D BMES^XPDUTL("Renaming some Sponsor entries")
S OLDNAME="Mental Health and Behavioral Science Strategic Group"
S NEWNAME="Office of Mental Health Services"
D RENAME^PXRMUTIL(811.6,OLDNAME,NEWNAME)
S OLDNAME="Mental Health and Behavioral Science Strategic Group and Women Veterans Health Program"
S NEWNAME="Office of Mental Health Services and Women Veterans Health Program"
D RENAME^PXRMUTIL(811.6,OLDNAME,NEWNAME)
Q
;
;==========================================
SENDPV ;Send the system level value of ORQQPX NEW REMINDER PARAMS.
N FROM,NODE,PARAM,SYSTEM,SUBJ,TO,VALUE
S NODE="PXRM*2.0*17"
K ^TMP(NODE,$J)
S PARAM="ORQQPX NEW REMINDER PARAMS"
;DBIA #2263
S VALUE=$$GET^XPAR("SYS",PARAM,1,"E")
;DBIA #1131 for ^XMB("NETNAME")
S FROM="PXRM*2.0*17 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="System level setting of "_PARAM
S ^TMP(NODE,$J,1,0)=SUBJECT_" is "_VALUE
S ^TMP(NODE,$J,2,0)="System is "_SYSTEM
D SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP17I 5082 printed Apr 09, 2024@20:49:49 Page 2
PXRMP17I ; SLC/PKR - Inits for PXRM*2.0*17. ;02/02/2010
+1 ;;2.0;CLINICAL REMINDERS;**17**;Feb 04, 2005;Build 102
+2 QUIT
+3 ;==========================================
ALLERGY ;Reset computed finding parameter for new version of VA-ALLERGY
+1 ;computed finding.
+2 DO BMES^XPDUTL("Reset computed finding parameter for new version of VA-ALLERGY")
+3 NEW CFIEN,CFPARAM,IEN,FINDING
+4 SET CFIEN=$ORDER(^PXRMD(811.4,"B","VA-ALLERGY",""))
+5 IF CFIEN=""
QUIT
+6 KILL ^TMP($JOB,"LIST")
+7 DO BLDLIST^PXRMFRPT(811.4,"PXRMD(811.4,",CFIEN,"LIST")
+8 ;Process definitions
+9 SET IEN=""
+10 FOR
SET IEN=$ORDER(^TMP($JOB,"LIST",811.4,CFIEN,"DEF",IEN))
if IEN=""
QUIT
Begin DoDot:1
+11 SET FINDING=""
+12 FOR
SET FINDING=$ORDER(^TMP($JOB,"LIST",811.4,CFIEN,"DEF",IEN,FINDING))
if FINDING=""
QUIT
Begin DoDot:2
+13 ;already converted if not equal to 2
SET CFPARAM=$GET(^PXD(811.9,IEN,20,FINDING,15))
if $LENGTH(CFPARAM,"
QUIT
+14 ;add 3 new parameters
SET ^PXD(811.9,IEN,20,FINDING,15)=CFPARAM_":*:*:*"
End DoDot:2
End DoDot:1
+15 ;Process terms
+16 SET IEN=""
+17 FOR
SET IEN=$ORDER(^TMP($JOB,"LIST",811.4,CFIEN,"TERM",IEN))
if IEN=""
QUIT
Begin DoDot:1
+18 SET FINDING=""
+19 FOR
SET FINDING=$ORDER(^TMP($JOB,"LIST",811.4,CFIEN,"TERM",IEN,FINDING))
if FINDING=""
QUIT
Begin DoDot:2
+20 ;already converted if not equal to 2
SET CFPARAM=$GET(^PXRMD(811.5,IEN,20,FINDING,15))
if $LENGTH(CFPARAM,"
QUIT
+21 ;add 3 new parameters
SET ^PXRMD(811.5,IEN,20,FINDING,15)=CFPARAM_":*:*:*"
End DoDot:2
End DoDot:1
+22 KILL ^TMP($JOB,"LIST")
+23 QUIT
+24 ;
+25 ;===============================================================
CFINC(Y) ;List of computed findings to include in the build.
+1 NEW CFLIST,CFNAME
+2 SET CFLIST("VA-ALLERGY")=""
+3 SET CFLIST("VA-ASU USER CLASS")=""
+4 SET CFLIST("VA-WAS INPATIENT")=""
+5 SET CFLIST("VA-ACTIVE PATIENT RECORD FLAGS")=""
+6 SET CFNAME=$PIECE($GET(^PXRMD(811.4,Y,0)),U)
+7 QUIT $SELECT($DATA(CFLIST(CFNAME)):1,1:0)
+8 ;
+9 ;===============================================================
DELDD ;Delete the old data dictionaries.
+1 ;N DIU,TEXT
+2 ;D EN^DDIOL("Removing old data dictionaries.")
+3 ;S DIU(0)=""
+4 ;F DIU=801.41,810.1,810.2,810.4,810.5,810.7,810.8,810.9,811.2,811.4,811.5,811.6,811.8,811.9 D
+5 ;. S TEXT=" Deleting data dictionary for file # "_DIU
+6 ;. D EN^DDIOL(TEXT)
+7 ;. D EN^DIU2
+8 QUIT
+9 ;
+10 ;==========================================
INILT ;Initialize list templates
+1 ;N IEN,IND,LIST,TEMP0
+2 ;D LTL^PXRMP12I(.LIST)
+3 ;S IND=0
+4 ;IA #4123
+5 ;F S IND=$O(LIST(IND)) Q:IND="" D
+6 ;. S IEN=$O(^SD(409.61,"B",LIST(IND),"")) Q:IEN=""
+7 ;. S TEMP0=$G(^SD(409.61,IEN,0))
+8 ;. K ^SD(409.61,IEN)
+9 ;. S ^SD(409.61,IEN,0)=TEMP0
+10 QUIT
+11 ;
+12 ;==========================================
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 ;===============================================================
MSTSYNC ;Run the MST synchronization.
+1 NEW TEXT
+2 KILL ZTSAVE
+3 SET ZTSAVE("STIME")=-1
+4 SET ZTRTN="SYNCH^PXRMMST"
+5 SET ZTDESC="Clinical Reminders MST synchronization job"
+6 SET ZTDTH=$$NOW^XLFDT
+7 SET ZTIO=""
+8 DO ^%ZTLOAD
+9 SET TEXT="MST synchronization queued, task number "_$GET(ZTSK)_"."
+10 DO BMES^XPDUTL(.TEXT)
+11 QUIT
+12 ;
+13 ;===============================================================
PRE ;Pre-init
+1 ;Disable options and protocols
+2 DO OPTION^PXRMUTIL("DISABLE")
+3 DO PROTOCOL^PXRMUTIL("DISABLE")
+4 DO DELEXE^PXRMEXSI("EXARRAY","PXRMP17E")
+5 QUIT
+6 ;
+7 ;===============================================================
POST ;Post-init
+1 ;Enable options and protocols
+2 DO OPTION^PXRMUTIL("ENABLE")
+3 DO PROTOCOL^PXRMUTIL("ENABLE")
+4 DO RENASPON^PXRMP17I
+5 DO SENDPV^PXRMP17I
+6 ;Install Exchange File entries.
+7 DO SMEXINS^PXRMEXSI("EXARRAY","PXRMP17E")
+8 ;Run the MST synchronization.
+9 DO MSTSYNC^PXRMP17I
+10 ;Reset computed finding parameter for new version of VA-ALLERGY.
+11 DO ALLERGY^PXRMP17U
+12 DO SETPVER^PXRMUTIL("2.0P17")
+13 QUIT
+14 ;
+15 ;===============================================================
RENASPON ;Rename some Sponsor file entries.
+1 NEW OLDNAME,NEWNAME
+2 DO BMES^XPDUTL("Renaming some Sponsor entries")
+3 SET OLDNAME="Mental Health and Behavioral Science Strategic Group"
+4 SET NEWNAME="Office of Mental Health Services"
+5 DO RENAME^PXRMUTIL(811.6,OLDNAME,NEWNAME)
+6 SET OLDNAME="Mental Health and Behavioral Science Strategic Group and Women Veterans Health Program"
+7 SET NEWNAME="Office of Mental Health Services and Women Veterans Health Program"
+8 DO RENAME^PXRMUTIL(811.6,OLDNAME,NEWNAME)
+9 QUIT
+10 ;
+11 ;==========================================
SENDPV ;Send the system level value of ORQQPX NEW REMINDER PARAMS.
+1 NEW FROM,NODE,PARAM,SYSTEM,SUBJ,TO,VALUE
+2 SET NODE="PXRM*2.0*17"
+3 KILL ^TMP(NODE,$JOB)
+4 SET PARAM="ORQQPX NEW REMINDER PARAMS"
+5 ;DBIA #2263
+6 SET VALUE=$$GET^XPAR("SYS",PARAM,1,"E")
+7 ;DBIA #1131 for ^XMB("NETNAME")
+8 SET FROM="PXRM*2.0*17 Install@"_^XMB("NETNAME")
+9 ;DBIA #2541
+10 SET SYSTEM=$$KSP^XUPARAM("WHERE")
+11 IF $$PROD^XUPROD(1)
SET TO("G.CLINICAL REMINDERS SUPPORT@DOMAIN.EXT")=""
+12 IF '$TEST
Begin DoDot:1
+13 NEW MGIEN,MGROUP
+14 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+15 SET MGROUP=$SELECT(MGIEN'="":"G."_$$GET1^DIQ(3.8,MGIEN,.01),1:DUZ)
+16 SET TO(MGROUP)=""
End DoDot:1
+17 SET SUBJECT="System level setting of "_PARAM
+18 SET ^TMP(NODE,$JOB,1,0)=SUBJECT_" is "_VALUE
+19 SET ^TMP(NODE,$JOB,2,0)="System is "_SYSTEM
+20 DO SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
+21 QUIT
+22 ;
