PXRMP71I ;ISP/AGP - PATCH 71 INSTALLATION ;Jul 07, 2021@16:42
;;2.0;CLINICAL REMINDERS;**71**;Feb 04, 2005;Build 43
Q
;
BLDARRAY(ARRAY,TYPE) ;
I TYPE="D" D Q
.S ARRAY("VA-WH BR BIRAD 1 MAMMOGRAM SCRN-1Y")="VA-WH BR MAMMOGRAM SCRN-1Y"
.S ARRAY("VA-WH BR BIRAD 1 MAMMOGRAM SCRN-2Y")="VA-WH BR MAMMOGRAM SCRN-2Y"
.S ARRAY("VA-WH BR BIRAD 1 RETURN TO AGE")="VA-WH BR RETURN TO AGE"
.S ARRAY("VA-WH BR BIRAD 1 RETURN TO AGE 1Y")="VA-WH BR RETURN TO AGE 1Y"
.S ARRAY("VA-WH BR BIRAD 1 RETURN TO AGE 2Y")="VA-WH BR RETURN TO AGE 2Y"
.S ARRAY("VA-WH BR BIRAD 1 NEED MAMMOGRAM")="VA-WH BR NEED MAMMOGRAM"
.S ARRAY("VA-WH BR BIRAD 1 NEED ULTRASOUND")="VA-WH BR NEED ULTRASOUND"
.S ARRAY("VA-WH BR BIRAD 1 NEED MRI")="VA-WH BR NEED MRI"
.S ARRAY("VA-WH BR BIRAD 0 PRIOR FILMS")="VA-WH BR PRIOR FILMS"
.S ARRAY("VA-WH BR BIRAD 0 ADDITIONAL IMAGING")="VA-WH BR ADDITIONAL IMAGING"
.S ARRAY("VA-WH BR BIRAD 0 NEED MAMMOGRAM")="VA-WH BR NEED MAMMOGRAM"
.S ARRAY("VA-WH BR BIRAD 0 NEED ULTRASOUND")="VA-WH BR NEED ULTRASOUND"
.S ARRAY("VA-WH BR BIRAD 0 NEED MRI")="VA-WH BR NEED MRI"
.S ARRAY("VA-WH BIRAD 0 REFER BIOPSY")="VA-WH REFER BIOPSY"
.S ARRAY("VA-WH BR BIRAD 0 REFERRALS")="VA-WH BR REFERRALS"
.S ARRAY("VA-WH BIRAD 0 REFER SURGEON")="VA-WH REFER SURGEON"
.S ARRAY("VA-WH BR BIRAD 0 REFER ONCOLOGIST")="VA-WH BR REFER ONCOLOGIST"
.S ARRAY("VA-WH BR BIRAD 0 CONSULT")="VA-WH BR CONSULT"
.S ARRAY("VA-WH BR BIRAD 0 CURRENTLY UNDER TREATMENT")="VA-WH BR CURRENTLY UNDER TREATMENT"
.S ARRAY("VA-WH BR BIRAD 0 BIOPSY ALREADY OBTAIN")="VA-WH BR BIOPSY ALREADY OBTAIN"
.S ARRAY("VA-WH BR GP BIRAD 1 OTHER")="VA-WH GP BR BIRAD SCREENING OTHER"
I TYPE="GF" D
.S ARRAY("BR 0 BIOPSY ALREADY OBTAIN")="BREAST BIOPSY ALREADY OBTAIN"
.S ARRAY("BR 0 CURRENTLY UNDER TREATMENT")="BREAST CURRENTLY UNDER TREATMENT"
.S ARRAY("BR BIRAD 1, next MAM AGE 1Y")="BREAST next MAM 1Y"
.S ARRAY("BR BIRAD 1, next MAM AGE 2Y")="BREAST next MAM 2Y"
.S ARRAY("BR BIRAD 0 CONSULT")="BREAST CONSULT"
.S ARRAY("BR 0 REFER TO ONCOLOGIST")="BREAST REFER TO ONCOLOGIST"
.S ARRAY("BR 0 REFER TO SURGEON")="BREAST REFER TO SURGEON"
.S ARRAY("BR 0 REFER FOR BIOPSY")="BREAST REFER FOR BIOPSY"
.S ARRAY("BR BIRAD 0 OBTAIN PRIOR FILMS")="BREAST OBTAIN PRIOR FILMS"
.S ARRAY("BR BIRAD 1, RETURN TO AGE SCREENING")="BREAST next MAM AT START AGE"
;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
;MODE values: I for include in build, A for include action.
N LN
S LN=0
;
S LN=LN+1
S ARRAY(LN,1)="PXRM*2.0*71 SMART UPDATES"
I MODE["I" S ARRAY(LN,2)="07/07/2021@09:59:53"
I MODE["A" S ARRAY(LN,3)="O"
;
S LN=LN+1
S ARRAY(LN,1)="PXRM*2.0*71 HI RISK MEDS CONTENT"
I MODE["I" S ARRAY(LN,2)="07/07/2021@16:35:08"
I MODE["A" S ARRAY(LN,3)="O"
Q
;
DIALOG ;
N ARRAY,DIE,DA,DR,NAME,NEWNAME,PXRMINST,Y
S NAME="VA-WH BR CLOSE CASCADE"
D RENAME^PXRMUTIL(801.41,NAME,"VA-WH BR DUPLICATE REPORT")
S PXRMINST=1
D BLDARRAY(.ARRAY,"D")
S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
.S NEWNAME=ARRAY(NAME)
.D RENAME^PXRMUTIL(801.41,NAME,NEWNAME)
S NAME="VA-WH SMART BR OUTSIDE REPORT"
S DA=+$O(^PXRMD(801.41,"B",NAME,"")) I DA=0 Q
D RENAME^PXRMUTIL(801.41,NAME,"ZZ"_NAME)
S DIE="^PXRMD(801.41,",DR="3///DISABLE AND DO NOT SEND MESSAGE"
D ^DIE
Q
;
GFINDS ;
N ARRAY,DA,DIE,DR,NAME,NEWNAME
D BLDARRAY(.ARRAY,"GF")
S DIE="^PXRMD(801.46,"
D RENAME^PXRMUTIL(801.46,"RETURN REPEAT MAMMOGRAM SCREENING","RETURN FOR MAMMOGRAM")
S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
.S NEWNAME=ARRAY(NAME)
.D RENAME^PXRMUTIL(801.46,NAME,NEWNAME)
.S DA=+$O(^PXRMD(801.46,"B",NEWNAME,""))
.I DA=0 D BMES^XPDUTL("Could not find General Finding: "_NEWNAME) Q
.S DR="4///^S X=NEWNAME"
.D ^DIE
Q
;
PRE ;
D OPTIONS^PXRMUTIL("DISABLE","Install of PXRM*2.0*71")
D PROTCOLS^PXRMUTIL("DISABLE","Install of PXRM*2.0*71")
D GFINDS
D DELEXE^PXRMEXSI("EXARRAY","PXRMP71I")
D DIALOG
D TERM
D REPOINT
Q
;
POST ;
D ROCGEDIT,RCOMP
D OPTIONS^PXRMUTIL("ENABLE","Install of PXRM*2.0*71")
D PROTCOLS^PXRMUTIL("ENABLE","Install of PXRM*2.0*71")
D SETPVER^PXRMUTIL("2.0P71"),SENDIM
Q
;
SENDIM ;Send install message.
N FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
S NODE="PXRM*2.0*71"
K ^TMP(NODE,$J)
;DBIA #1131 for ^XMB("NETNAME")
S FROM=NODE_" 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 "_NODE
S ^TMP(NODE,$J,1,0)=NODE_" was installed."
S ^TMP(NODE,$J,2,0)="System is "_SYSTEM
D SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
Q
;
REPOINT ;
N BIEN,BNAME,DA,DIK,DR,GIEN,GNAME,IOP,PXRMINST,PXRMTID,TEXT
S BNAME="VA-WH BR CA 40-44 WANTS SCREEN TERM "
S GNAME="VA-WH BR CA 40-44 WANTS SCREEN TERM"
S BIEN=+$O(^PXRMD(811.5,"B",BNAME,"")) I BIEN=0 Q
S GIEN=+$O(^PXRMD(811.5,"B",GNAME,"")) I GIEN=0 D BMES^XPDUTL("Reminder Term: "_GNAME_" not found") Q
D BMES^XPDUTL("Repointing Reminder Term: "_BNAME)
S PXRMTID(1)=BIEN_U_GIEN
S PXRMINST=1
;S OLDIOP=IOP
S IOP="`"_+$P(IO("HOME"),U)
D EN^DITP(811.5,.PXRMTID)
S DIK="^PXRMD(811.5,"
S DA=BIEN
S DR=".01///@"
D BMES^XPDUTL("Deleting Reminder Term: "_BNAME)
D ^DIK
D INIT^XPDID
Q
;
TERM ;
D RENAME^PXRMUTIL(811.5,"VA-WH MRI OF THE BREASTS CODES","VA-WH MRI BREASTS CODES")
D RENAME^PXRMUTIL(811.5,"VA-WH ULTRASOUND OF THE BREAST CODES","VA-WH ULTRASOUND BREAST CODES")
Q
;
ROCGEDIT ;Remove items from order check items group
N GIEN,GNAME,MESSAGE,MEDS,MED,MIEN,REMOVE,IIEN,PXRMINST,EXIT
S GNAME="VA-WH HIRISK MEDICATIONS (EXTREME RISK) GROUP"
S GIEN=+$O(^PXD(801,"B",GNAME,""))
I GIEN=0 D
.S MESSAGE(1)="ERROR:"
.S MESSAGE(2)="Could not find the "_GNAME_" reminder order check items group."
.D BMES^XPDUTL(.MESSAGE) K MESSAGE
I GIEN>0 D
.S MEDS("ABACAVIR/DOLUTEGRAVIR/LAMIVUDINE")="",MEDS("DOLUTEGRAVIR")=""
.S MEDS("DOLUTEGRAVIR/RILPIVIRINE")="",MEDS=3
.S MED="" F S MED=$O(MEDS(MED)) Q:(MED="")!($G(MIEN)=0) D
..D ZERO^PSN50P6(,MED,DT,1,"PXRMINQ")
..S MIEN=+$O(^TMP($J,"PXRMINQ","B",MED,0))
..K ^TMP($J,"PXRMINQ")
..I MIEN=0 D Q
...S MESSAGE(1)="ERROR:"
...S MESSAGE(2)="Could not find the "_MED_" entry in the"
...S MESSAGE(3)="VA GENERIC file (#50.6)."
...D BMES^XPDUTL(.MESSAGE)
...K MEDS(MED),MESSAGE S MEDS=MEDS-1
..S IIEN=+$O(^PXD(801,"O",MIEN_";PSNDF(50.6,",GIEN,0))
..I IIEN=0 K MEDS(MED) S MEDS=MEDS-1 Q
..S MEDS(MED)=IIEN_","_GIEN_","
.I MEDS>0 D
..S MESSAGE(1)="Removing "_$S(MEDS=1:"a ",1:"")_"medication"
..S MESSAGE(1)=MESSAGE(1)_$S(MEDS>1:"s",1:"")_" from the "_GNAME
..S MESSAGE(2)="reminder order check items group:"
..D BMES^XPDUTL(.MESSAGE) K MESSAGE
..S PXRMINST=1
..S MED="" F S MED=$O(MEDS(MED)) Q:(MED="")!($G(EXIT)) D
...D MES^XPDUTL(" "_MED)
...S REMOVE(801.015,MEDS(MED),.01)="@"
...D FILE^DIE("K","REMOVE")
...I $D(^TMP("DIERR",$J)) D Q
....D MSG^DIALOG("AE",.MESSAGE,$G(IOM,75),2)
....K ^TMP("DIERR",$J)
....D MES^XPDUTL(" ERROR:"),MES^XPDUTL(.MESSAGE)
....S EXIT=1
..I '$D(EXIT) D
...D MES^XPDUTL(" DONE")
S GNAME="VA-WH HIRISK MEDICATIONS (LACTATION LEVEL 2) GROUP"
S GIEN=+$O(^PXD(801,"B",GNAME,""))
I GIEN=0 D
.S MESSAGE(1)="ERROR:"
.S MESSAGE(2)="Could not find the "_GNAME_" reminder order check items group."
.D BMES^XPDUTL(.MESSAGE) K MESSAGE
I GIEN>0 D
.K REMOVE
.S MIEN=0 F S MIEN=$O(^PXD(801,GIEN,1.5,MIEN)) Q:'+MIEN D
..S REMOVE(801.015,MIEN_","_GIEN_",",.01)="@"
.I $D(REMOVE(801.015))>9 D
..S MESSAGE(1)="Removing all items from the "_GNAME
..S MESSAGE(2)="reminder order check items group:"
..D BMES^XPDUTL(.MESSAGE) K MESSAGE
..D FILE^DIE("K","REMOVE")
..I $D(^TMP("DIERR",$J)) D Q
...D MSG^DIALOG("AE",.MESSAGE,$G(IOM,75),2)
...K ^TMP("DIERR",$J)
...D MES^XPDUTL(" ERROR:"),MES^XPDUTL(.MESSAGE)
...K MESSAGE
..D MES^XPDUTL(" DONE")
Q
;
RCOMP ;Remove components from the system
N TYPES,ITEMS,GLOBAL,ITEM,TEST,IEN,MSG
S TYPES("^PXD(811.9,")="reminder definition"
S TYPES("^PXD(801.1,")="order check rule"
S TYPES("^PXRMD(811.5,")="term"
S TYPES("^PXD(801,")="order check group"
S TYPES("^PXD(811.2,")="taxonomy"
S TYPES("^PXRM(810.4,")="list rule"
S TYPES("^PXRMD(801.41,")="reminder dialog"
S ITEMS("^PXRMD(801.41,","VA-WH TD CLEAR PREGNANCY ALERT")="@"
S ITEMS("^PXRMD(801.41,","VA-WH TD CLEAR LACTATION ALERT")="@"
S GLOBAL="" F S GLOBAL=$O(ITEMS(GLOBAL)) Q:GLOBAL="" S ITEM="" F S ITEM=$O(ITEMS(GLOBAL,ITEM)) Q:ITEM="" D
.S TEST=GLOBAL_"""B"","""_ITEM_""",0)"
.S IEN=+$O(@TEST)
.Q:'IEN
.K MSG
.S MSG(1)=" "_$S(ITEMS(GLOBAL,ITEM)'="@":"Renaming",1:"Deleting")_" the "_ITEM,MSG(2)=" "_TYPES(GLOBAL)_"..."
.D MES^XPDUTL(.MSG)
.I ITEMS(GLOBAL,ITEM)="@" D DELTLFE^PXRMUTIL($P($P(GLOBAL,"(",2),","),ITEM)
.I ITEMS(GLOBAL,ITEM)'="@" D RENAME^PXRMUTIL($P($P(GLOBAL,"(",2),","),ITEM,ITEMS(GLOBAL,ITEM))
.D MES^XPDUTL(" DONE")
Q
;
INCCF(NAME) ;Include REMINDER COMPUTED FINDING file entry?
Q:NAME="VA-WH PATIENT DOCUMENTATION" 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP71I 9254 printed Dec 13, 2024@01:48:13 Page 2
PXRMP71I ;ISP/AGP - PATCH 71 INSTALLATION ;Jul 07, 2021@16:42
+1 ;;2.0;CLINICAL REMINDERS;**71**;Feb 04, 2005;Build 43
+2 QUIT
+3 ;
BLDARRAY(ARRAY,TYPE) ;
+1 IF TYPE="D"
Begin DoDot:1
+2 SET ARRAY("VA-WH BR BIRAD 1 MAMMOGRAM SCRN-1Y")="VA-WH BR MAMMOGRAM SCRN-1Y"
+3 SET ARRAY("VA-WH BR BIRAD 1 MAMMOGRAM SCRN-2Y")="VA-WH BR MAMMOGRAM SCRN-2Y"
+4 SET ARRAY("VA-WH BR BIRAD 1 RETURN TO AGE")="VA-WH BR RETURN TO AGE"
+5 SET ARRAY("VA-WH BR BIRAD 1 RETURN TO AGE 1Y")="VA-WH BR RETURN TO AGE 1Y"
+6 SET ARRAY("VA-WH BR BIRAD 1 RETURN TO AGE 2Y")="VA-WH BR RETURN TO AGE 2Y"
+7 SET ARRAY("VA-WH BR BIRAD 1 NEED MAMMOGRAM")="VA-WH BR NEED MAMMOGRAM"
+8 SET ARRAY("VA-WH BR BIRAD 1 NEED ULTRASOUND")="VA-WH BR NEED ULTRASOUND"
+9 SET ARRAY("VA-WH BR BIRAD 1 NEED MRI")="VA-WH BR NEED MRI"
+10 SET ARRAY("VA-WH BR BIRAD 0 PRIOR FILMS")="VA-WH BR PRIOR FILMS"
+11 SET ARRAY("VA-WH BR BIRAD 0 ADDITIONAL IMAGING")="VA-WH BR ADDITIONAL IMAGING"
+12 SET ARRAY("VA-WH BR BIRAD 0 NEED MAMMOGRAM")="VA-WH BR NEED MAMMOGRAM"
+13 SET ARRAY("VA-WH BR BIRAD 0 NEED ULTRASOUND")="VA-WH BR NEED ULTRASOUND"
+14 SET ARRAY("VA-WH BR BIRAD 0 NEED MRI")="VA-WH BR NEED MRI"
+15 SET ARRAY("VA-WH BIRAD 0 REFER BIOPSY")="VA-WH REFER BIOPSY"
+16 SET ARRAY("VA-WH BR BIRAD 0 REFERRALS")="VA-WH BR REFERRALS"
+17 SET ARRAY("VA-WH BIRAD 0 REFER SURGEON")="VA-WH REFER SURGEON"
+18 SET ARRAY("VA-WH BR BIRAD 0 REFER ONCOLOGIST")="VA-WH BR REFER ONCOLOGIST"
+19 SET ARRAY("VA-WH BR BIRAD 0 CONSULT")="VA-WH BR CONSULT"
+20 SET ARRAY("VA-WH BR BIRAD 0 CURRENTLY UNDER TREATMENT")="VA-WH BR CURRENTLY UNDER TREATMENT"
+21 SET ARRAY("VA-WH BR BIRAD 0 BIOPSY ALREADY OBTAIN")="VA-WH BR BIOPSY ALREADY OBTAIN"
+22 SET ARRAY("VA-WH BR GP BIRAD 1 OTHER")="VA-WH GP BR BIRAD SCREENING OTHER"
End DoDot:1
QUIT
+23 IF TYPE="GF"
Begin DoDot:1
+24 SET ARRAY("BR 0 BIOPSY ALREADY OBTAIN")="BREAST BIOPSY ALREADY OBTAIN"
+25 SET ARRAY("BR 0 CURRENTLY UNDER TREATMENT")="BREAST CURRENTLY UNDER TREATMENT"
+26 SET ARRAY("BR BIRAD 1, next MAM AGE 1Y")="BREAST next MAM 1Y"
+27 SET ARRAY("BR BIRAD 1, next MAM AGE 2Y")="BREAST next MAM 2Y"
+28 SET ARRAY("BR BIRAD 0 CONSULT")="BREAST CONSULT"
+29 SET ARRAY("BR 0 REFER TO ONCOLOGIST")="BREAST REFER TO ONCOLOGIST"
+30 SET ARRAY("BR 0 REFER TO SURGEON")="BREAST REFER TO SURGEON"
+31 SET ARRAY("BR 0 REFER FOR BIOPSY")="BREAST REFER FOR BIOPSY"
+32 SET ARRAY("BR BIRAD 0 OBTAIN PRIOR FILMS")="BREAST OBTAIN PRIOR FILMS"
+33 SET ARRAY("BR BIRAD 1, RETURN TO AGE SCREENING")="BREAST next MAM AT START AGE"
End DoDot:1
+34 ;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
+1 ;MODE values: I for include in build, A for include action.
+2 NEW LN
+3 SET LN=0
+4 ;
+5 SET LN=LN+1
+6 SET ARRAY(LN,1)="PXRM*2.0*71 SMART UPDATES"
+7 IF MODE["I"
SET ARRAY(LN,2)="07/07/2021@09:59:53"
+8 IF MODE["A"
SET ARRAY(LN,3)="O"
+9 ;
+10 SET LN=LN+1
+11 SET ARRAY(LN,1)="PXRM*2.0*71 HI RISK MEDS CONTENT"
+12 IF MODE["I"
SET ARRAY(LN,2)="07/07/2021@16:35:08"
+13 IF MODE["A"
SET ARRAY(LN,3)="O"
+14 QUIT
+15 ;
DIALOG ;
+1 NEW ARRAY,DIE,DA,DR,NAME,NEWNAME,PXRMINST,Y
+2 SET NAME="VA-WH BR CLOSE CASCADE"
+3 DO RENAME^PXRMUTIL(801.41,NAME,"VA-WH BR DUPLICATE REPORT")
+4 SET PXRMINST=1
+5 DO BLDARRAY(.ARRAY,"D")
+6 SET NAME=""
FOR
SET NAME=$ORDER(ARRAY(NAME))
if NAME=""
QUIT
Begin DoDot:1
+7 SET NEWNAME=ARRAY(NAME)
+8 DO RENAME^PXRMUTIL(801.41,NAME,NEWNAME)
End DoDot:1
+9 SET NAME="VA-WH SMART BR OUTSIDE REPORT"
+10 SET DA=+$ORDER(^PXRMD(801.41,"B",NAME,""))
IF DA=0
QUIT
+11 DO RENAME^PXRMUTIL(801.41,NAME,"ZZ"_NAME)
+12 SET DIE="^PXRMD(801.41,"
SET DR="3///DISABLE AND DO NOT SEND MESSAGE"
+13 DO ^DIE
+14 QUIT
+15 ;
GFINDS ;
+1 NEW ARRAY,DA,DIE,DR,NAME,NEWNAME
+2 DO BLDARRAY(.ARRAY,"GF")
+3 SET DIE="^PXRMD(801.46,"
+4 DO RENAME^PXRMUTIL(801.46,"RETURN REPEAT MAMMOGRAM SCREENING","RETURN FOR MAMMOGRAM")
+5 SET NAME=""
FOR
SET NAME=$ORDER(ARRAY(NAME))
if NAME=""
QUIT
Begin DoDot:1
+6 SET NEWNAME=ARRAY(NAME)
+7 DO RENAME^PXRMUTIL(801.46,NAME,NEWNAME)
+8 SET DA=+$ORDER(^PXRMD(801.46,"B",NEWNAME,""))
+9 IF DA=0
DO BMES^XPDUTL("Could not find General Finding: "_NEWNAME)
QUIT
+10 SET DR="4///^S X=NEWNAME"
+11 DO ^DIE
End DoDot:1
+12 QUIT
+13 ;
PRE ;
+1 DO OPTIONS^PXRMUTIL("DISABLE","Install of PXRM*2.0*71")
+2 DO PROTCOLS^PXRMUTIL("DISABLE","Install of PXRM*2.0*71")
+3 DO GFINDS
+4 DO DELEXE^PXRMEXSI("EXARRAY","PXRMP71I")
+5 DO DIALOG
+6 DO TERM
+7 DO REPOINT
+8 QUIT
+9 ;
POST ;
+1 DO ROCGEDIT
DO RCOMP
+2 DO OPTIONS^PXRMUTIL("ENABLE","Install of PXRM*2.0*71")
+3 DO PROTCOLS^PXRMUTIL("ENABLE","Install of PXRM*2.0*71")
+4 DO SETPVER^PXRMUTIL("2.0P71")
DO SENDIM
+5 QUIT
+6 ;
SENDIM ;Send install message.
+1 NEW FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
+2 SET NODE="PXRM*2.0*71"
+3 KILL ^TMP(NODE,$JOB)
+4 ;DBIA #1131 for ^XMB("NETNAME")
+5 SET FROM=NODE_" 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 "_NODE
+15 SET ^TMP(NODE,$JOB,1,0)=NODE_" was installed."
+16 SET ^TMP(NODE,$JOB,2,0)="System is "_SYSTEM
+17 DO SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
+18 QUIT
+19 ;
REPOINT ;
+1 NEW BIEN,BNAME,DA,DIK,DR,GIEN,GNAME,IOP,PXRMINST,PXRMTID,TEXT
+2 SET BNAME="VA-WH BR CA 40-44 WANTS SCREEN TERM "
+3 SET GNAME="VA-WH BR CA 40-44 WANTS SCREEN TERM"
+4 SET BIEN=+$ORDER(^PXRMD(811.5,"B",BNAME,""))
IF BIEN=0
QUIT
+5 SET GIEN=+$ORDER(^PXRMD(811.5,"B",GNAME,""))
IF GIEN=0
DO BMES^XPDUTL("Reminder Term: "_GNAME_" not found")
QUIT
+6 DO BMES^XPDUTL("Repointing Reminder Term: "_BNAME)
+7 SET PXRMTID(1)=BIEN_U_GIEN
+8 SET PXRMINST=1
+9 ;S OLDIOP=IOP
+10 SET IOP="`"_+$PIECE(IO("HOME"),U)
+11 DO EN^DITP(811.5,.PXRMTID)
+12 SET DIK="^PXRMD(811.5,"
+13 SET DA=BIEN
+14 SET DR=".01///@"
+15 DO BMES^XPDUTL("Deleting Reminder Term: "_BNAME)
+16 DO ^DIK
+17 DO INIT^XPDID
+18 QUIT
+19 ;
TERM ;
+1 DO RENAME^PXRMUTIL(811.5,"VA-WH MRI OF THE BREASTS CODES","VA-WH MRI BREASTS CODES")
+2 DO RENAME^PXRMUTIL(811.5,"VA-WH ULTRASOUND OF THE BREAST CODES","VA-WH ULTRASOUND BREAST CODES")
+3 QUIT
+4 ;
ROCGEDIT ;Remove items from order check items group
+1 NEW GIEN,GNAME,MESSAGE,MEDS,MED,MIEN,REMOVE,IIEN,PXRMINST,EXIT
+2 SET GNAME="VA-WH HIRISK MEDICATIONS (EXTREME RISK) GROUP"
+3 SET GIEN=+$ORDER(^PXD(801,"B",GNAME,""))
+4 IF GIEN=0
Begin DoDot:1
+5 SET MESSAGE(1)="ERROR:"
+6 SET MESSAGE(2)="Could not find the "_GNAME_" reminder order check items group."
+7 DO BMES^XPDUTL(.MESSAGE)
KILL MESSAGE
End DoDot:1
+8 IF GIEN>0
Begin DoDot:1
+9 SET MEDS("ABACAVIR/DOLUTEGRAVIR/LAMIVUDINE")=""
SET MEDS("DOLUTEGRAVIR")=""
+10 SET MEDS("DOLUTEGRAVIR/RILPIVIRINE")=""
SET MEDS=3
+11 SET MED=""
FOR
SET MED=$ORDER(MEDS(MED))
if (MED="")!($GET(MIEN)=0)
QUIT
Begin DoDot:2
+12 DO ZERO^PSN50P6(,MED,DT,1,"PXRMINQ")
+13 SET MIEN=+$ORDER(^TMP($JOB,"PXRMINQ","B",MED,0))
+14 KILL ^TMP($JOB,"PXRMINQ")
+15 IF MIEN=0
Begin DoDot:3
+16 SET MESSAGE(1)="ERROR:"
+17 SET MESSAGE(2)="Could not find the "_MED_" entry in the"
+18 SET MESSAGE(3)="VA GENERIC file (#50.6)."
+19 DO BMES^XPDUTL(.MESSAGE)
+20 KILL MEDS(MED),MESSAGE
SET MEDS=MEDS-1
End DoDot:3
QUIT
+21 SET IIEN=+$ORDER(^PXD(801,"O",MIEN_";PSNDF(50.6,",GIEN,0))
+22 IF IIEN=0
KILL MEDS(MED)
SET MEDS=MEDS-1
QUIT
+23 SET MEDS(MED)=IIEN_","_GIEN_","
End DoDot:2
+24 IF MEDS>0
Begin DoDot:2
+25 SET MESSAGE(1)="Removing "_$SELECT(MEDS=1:"a ",1:"")_"medication"
+26 SET MESSAGE(1)=MESSAGE(1)_$SELECT(MEDS>1:"s",1:"")_" from the "_GNAME
+27 SET MESSAGE(2)="reminder order check items group:"
+28 DO BMES^XPDUTL(.MESSAGE)
KILL MESSAGE
+29 SET PXRMINST=1
+30 SET MED=""
FOR
SET MED=$ORDER(MEDS(MED))
if (MED="")!($GET(EXIT))
QUIT
Begin DoDot:3
+31 DO MES^XPDUTL(" "_MED)
+32 SET REMOVE(801.015,MEDS(MED),.01)="@"
+33 DO FILE^DIE("K","REMOVE")
+34 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:4
+35 DO MSG^DIALOG("AE",.MESSAGE,$GET(IOM,75),2)
+36 KILL ^TMP("DIERR",$JOB)
+37 DO MES^XPDUTL(" ERROR:")
DO MES^XPDUTL(.MESSAGE)
+38 SET EXIT=1
End DoDot:4
QUIT
End DoDot:3
+39 IF '$DATA(EXIT)
Begin DoDot:3
+40 DO MES^XPDUTL(" DONE")
End DoDot:3
End DoDot:2
End DoDot:1
+41 SET GNAME="VA-WH HIRISK MEDICATIONS (LACTATION LEVEL 2) GROUP"
+42 SET GIEN=+$ORDER(^PXD(801,"B",GNAME,""))
+43 IF GIEN=0
Begin DoDot:1
+44 SET MESSAGE(1)="ERROR:"
+45 SET MESSAGE(2)="Could not find the "_GNAME_" reminder order check items group."
+46 DO BMES^XPDUTL(.MESSAGE)
KILL MESSAGE
End DoDot:1
+47 IF GIEN>0
Begin DoDot:1
+48 KILL REMOVE
+49 SET MIEN=0
FOR
SET MIEN=$ORDER(^PXD(801,GIEN,1.5,MIEN))
if '+MIEN
QUIT
Begin DoDot:2
+50 SET REMOVE(801.015,MIEN_","_GIEN_",",.01)="@"
End DoDot:2
+51 IF $DATA(REMOVE(801.015))>9
Begin DoDot:2
+52 SET MESSAGE(1)="Removing all items from the "_GNAME
+53 SET MESSAGE(2)="reminder order check items group:"
+54 DO BMES^XPDUTL(.MESSAGE)
KILL MESSAGE
+55 DO FILE^DIE("K","REMOVE")
+56 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:3
+57 DO MSG^DIALOG("AE",.MESSAGE,$GET(IOM,75),2)
+58 KILL ^TMP("DIERR",$JOB)
+59 DO MES^XPDUTL(" ERROR:")
DO MES^XPDUTL(.MESSAGE)
+60 KILL MESSAGE
End DoDot:3
QUIT
+61 DO MES^XPDUTL(" DONE")
End DoDot:2
End DoDot:1
+62 QUIT
+63 ;
RCOMP ;Remove components from the system
+1 NEW TYPES,ITEMS,GLOBAL,ITEM,TEST,IEN,MSG
+2 SET TYPES("^PXD(811.9,")="reminder definition"
+3 SET TYPES("^PXD(801.1,")="order check rule"
+4 SET TYPES("^PXRMD(811.5,")="term"
+5 SET TYPES("^PXD(801,")="order check group"
+6 SET TYPES("^PXD(811.2,")="taxonomy"
+7 SET TYPES("^PXRM(810.4,")="list rule"
+8 SET TYPES("^PXRMD(801.41,")="reminder dialog"
+9 SET ITEMS("^PXRMD(801.41,","VA-WH TD CLEAR PREGNANCY ALERT")="@"
+10 SET ITEMS("^PXRMD(801.41,","VA-WH TD CLEAR LACTATION ALERT")="@"
+11 SET GLOBAL=""
FOR
SET GLOBAL=$ORDER(ITEMS(GLOBAL))
if GLOBAL=""
QUIT
SET ITEM=""
FOR
SET ITEM=$ORDER(ITEMS(GLOBAL,ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+12 SET TEST=GLOBAL_"""B"","""_ITEM_""",0)"
+13 SET IEN=+$ORDER(@TEST)
+14 if 'IEN
QUIT
+15 KILL MSG
+16 SET MSG(1)=" "_$SELECT(ITEMS(GLOBAL,ITEM)'="@":"Renaming",1:"Deleting")_" the "_ITEM
SET MSG(2)=" "_TYPES(GLOBAL)_"..."
+17 DO MES^XPDUTL(.MSG)
+18 IF ITEMS(GLOBAL,ITEM)="@"
DO DELTLFE^PXRMUTIL($PIECE($PIECE(GLOBAL,"(",2),","),ITEM)
+19 IF ITEMS(GLOBAL,ITEM)'="@"
DO RENAME^PXRMUTIL($PIECE($PIECE(GLOBAL,"(",2),","),ITEM,ITEMS(GLOBAL,ITEM))
+20 DO MES^XPDUTL(" DONE")
End DoDot:1
+21 QUIT
+22 ;
INCCF(NAME) ;Include REMINDER COMPUTED FINDING file entry?
+1 if NAME="VA-WH PATIENT DOCUMENTATION"
QUIT 1
+2 QUIT 0
