PXRMP45I ;ISP/RFR - PATCH 45 INSTALLATION ;Jan 03, 2020@14:35
;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
I '$$PATCH^XPDUTL("PXRM*2.0*45") D
.N ENTRY,ENTRIES
.S ENTRIES("UPDATE_2_0_54 VA-TERATOGENIC MEDICATIONS ORDER CHECKS(UPDATE #4)")="06/25/2018@08:36:44"
.S ENTRIES("UPDATE_2_0_16 VA-WH MAMMOGRAM SCREENING")="09/15/2017@05:59:09"
.S ENTRY="" F S ENTRY=$O(ENTRIES(ENTRY)) Q:ENTRY="" I +$$EXCHINCK(ENTRY,ENTRIES(ENTRY))<1 D
..W !,ENTRY,!,"is not installed.",!
..S XPDABORT=2
Q
;
DLGTTL ;dialog and title text pairs for link code
;;VA-WH SMART PT NOTIFICATION^SMART PATIENT NOTIFICATION
;;VA-WH SMART BREAST IMAGING FOLLOW-UP^SMART BREAST IMAGING FOLLOW-UP^BREAST IMAGING FOLLOW-UP
;;VA-WH SMART BR OUTSIDE REPORT^SMART OUTSIDE BREAST IMAGE RESULTS
;;VA-WH UPDATE PREGNANCY STATUS^PREGNANCY STATUS UPDATE REVIEW^PREGNANCY/INTENTIONS/CONTRACEPTION
;;VA-WH UPDATE LACTATION STATUS^LACTATION STATUS UPDATE REVIEW^UPDATE LACTATION STATUS
;;EOF
;
EXCHINCK(EXNAME,DPACKED) ;Given the name and the date packed of an Exchange
;entry return:
; -1 if the entry does not exist
; 0 if it has never been installed
; 1^installation date/time
I $G(EXNAME)="" Q -1
I $G(DPACKED)="" Q -1
N DTP,IEN,IND,LASTINDT
D DT^DILF("ST",DPACKED,.DTP)
S IEN=+$O(^PXD(811.8,"B",EXNAME,DTP,""))
I IEN=0 Q -1
S IND=+$O(^PXD(811.8,IEN,130,"B"),-1)
I IND=0 Q 0
S LASTINDT=$P(^PXD(811.8,IEN,130,IND,0),U,1)
Q 1_U_LASTINDT
;
FMERROR(MESSAGES) ;RETURN FILEMAN ERROR MESSAGE(S) AS STRING
N ITEM,ERROR,ERRNUM,ERRORS
S ERROR="",ERRNUM=0
F S ERRNUM=$O(MESSAGES("DIERR",ERRNUM)) Q:'+ERRNUM D
.Q:$D(ERRORS($G(MESSAGES("DIERR",ERRNUM))))
.S ITEM=0 F S ITEM=$O(MESSAGES("DIERR",ERRNUM,"TEXT",ITEM)) Q:ITEM="" D
..S ERROR=$S(ERROR'="":ERROR_" ",1:"")_MESSAGES("DIERR",ERRNUM,"TEXT",ITEM)
.S ERRORS=$G(MESSAGES("DIERR",ERRNUM))
.I ERRORS'="" S ERRORS(ERRORS)=""
Q ERROR
;
LINK ;link dialogs, templates, notes
D BMES^XPDUTL(" Creating entries in shared templates...")
N GLOBAL,REMDLG,TEMPNAME,TITLE,TEXTPAIR,TEXTCNT,TMPONLY
S GLOBAL="TIU(8925.1,",TMPONLY=0
F TEXTCNT=1:1 S TEXTPAIR=$P($T(DLGTTL+TEXTCNT),";",3) Q:TEXTPAIR="EOF" D
. S REMDLG=$P(TEXTPAIR,U),TITLE=$P(TEXTPAIR,U,2),TEMPNAME=$P(TEXTPAIR,U,3)
. D LINK2TIU^PXRMDUTL(REMDLG,TITLE,TEMPNAME,TMPONLY,GLOBAL)
D MES^XPDUTL(" DONE")
Q
;
LINK2WH ;update WV PROCEDURE TYPE file
D BMES^XPDUTL(" Updating WV PROCEDURE TYPE file entries...")
N DA,DIE,DR,RTIEN,RTNAME,WHARRAY,WHIEN,WHNAME
S DIE="^WV(790.2,",DR="3////^S X=RTIEN"
S WHARRAY("BREAST MRI")="VA-WH MRI OF THE BREASTS CODES"
S WHARRAY("BREAST ULTRASOUND")="VA-WH ULTRASOUND OF THE BREAST CODES"
S WHARRAY("MAMMOGRAM DX BILAT")="VA-WH MAMMOGRAM BILAT DIAGNOSTIC CODES"
S WHARRAY("MAMMOGRAM DX UNILAT")="VA-WH MAMMOGRAM UNILAT DIAGNOSTIC CODES"
S WHARRAY("MAMMOGRAM SCREENING")="VA-WH MAMMOGRAM SCREENING CODES"
S WHNAME="" F S WHNAME=$O(WHARRAY(WHNAME)) Q:WHNAME="" D
.S RTNAME=WHARRAY(WHNAME)
.D BMES^XPDUTL(" Updating WV Procedure Type "_WHNAME)
.S WHIEN=$O(^WV(790.2,"B",WHNAME,"")) I WHIEN'>0 D BMES^XPDUTL("Could not find entry: "_WHNAME) Q
.S RTIEN=$O(^PXRMD(811.5,"B",RTNAME,"")) I RTIEN'>0 D BMES^XPDUTL("Could not find reminder term: "_RTNAME) Q
.S DA=WHIEN
.D ^DIE
D MES^XPDUTL(" DONE")
Q
;
POST ;Post-init
N DIK,LUVALUE,LIST,DIK,DA,CNT,FDA,SUB,IEN,IENS,NAME,OI
D POSTOC
D BMES^XPDUTL(" Reindexing the DISPLAY NAME field in file #801.1...")
S DIK="^PXD(801.1,",DIK(1)=1 D ENALL2^DIK,ENALL^DIK
D MES^XPDUTL(" DONE")
D POST^PXRMP45D,REBUILD^PXRMP45D
;Install Exchange File entries.
D SMEXINS^PXRMEXSI("EXARRAY","PXRMP45E")
D SETPARM,RENAME("POST-INSTALL"),RENAME("BUILD265")
;Enable options and protocols
D OPTIONS^PXRMUTIL("ENABLE","Install of PXRM*2.0*45")
D PROTCOLS^PXRMUTIL("ENABLE","Install of PXRM*2.0*45")
D SETPVER^PXRMUTIL("2.0P45"),SENDIM
K PXRMINST,PXRMINCF
Q
;
POSTOC ;
N CNT,DIK,DONE,FDA,IEN,IENS,NAME,OI,SUB
S SUB="PXRM ORDER CHECK CONVERSION"
I '$D(^XTMP(SUB)) Q
D BMES^XPDUTL(" Updating Reminder Order Check Groups...")
S IEN=0 F S IEN=$O(^PXD(801,IEN)) Q:+IEN'>0 D
.K FDA S CNT=0 I '$D(^XTMP(SUB,IEN)) Q
.S NAME=$P($G(^PXD(801,IEN,0)),U)
.D MES^XPDUTL(" Updating group: "_NAME)
.S OI=0 F S OI=$O(^XTMP(SUB,IEN,OI)) Q:OI'>0 D
..S CNT=CNT+1,IENS="+"_CNT_","_IEN_","
..S FDA(801.015,IENS,.01)=$S(OI[";":OI,1:OI_";ORD(101.43,")
.I $D(FDA) D UPDATE(.FDA,SUB,NAME,IEN)
D MES^XPDUTL(" DONE")
D BMES^XPDUTL(" Reindexing file #801...")
S DIK="^PXD(801,"
D IXALL2^DIK,IXALL^DIK
S IEN=0,DONE=1 F S IEN=$O(^XTMP(SUB,IEN)) Q:+IEN'>0!(DONE=0) D
.I +$G(^XTMP(SUB,IEN,"DONE"))=0 S DONE=0
I DONE=1 K ^XTMP(SUB)
D MES^XPDUTL(" DONE")
Q
;
PRE ;Pre-init
;Disable options and protocols
D OPTIONS^PXRMUTIL("DISABLE","Install of PXRM*2.0*45")
D PROTCOLS^PXRMUTIL("DISABLE","Install of PXRM*2.0*45")
D DELEXE^PXRMEXSI("EXARRAY","PXRMP45E")
S (PXRMINST,PXRMINCF)=1
D PREOC,PRE^PXRMP45D,RENAME("PRE-INSTALL")
;Delete exisitng data dictionaries
N DIU,DA,DIK,IEN,OI,SUB
S DIU(0)=""
F DIU=801,801.41,801.46,801.47,801.48,811.8,811.9 D MES^XPDUTL(" Deleting data dictionary for file #"_DIU_"..."),EN^DIU2,MES^XPDUTL(" DONE")
Q
;
PREOC ;
N FOUND,IEN,OI,SUB,MSG
S SUB="PXRM ORDER CHECK CONVERSION"
K ^XTMP(SUB)
S ^XTMP(SUB,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"PXRM Patch 45 Order Check Conversion",FOUND=0
S MSG(1)=" Copying existing orderable item data from REMINDER ORDER CHECK ITEMS GROUP",MSG(2)=" file..."
D MES^XPDUTL(.MSG)
S IEN=0 F S IEN=$O(^PXD(801,IEN)) Q:IEN'>0 D
.I '$D(^PXD(801,IEN,2,"B")) Q
.S OI=0 F S OI=$O(^PXD(801,IEN,2,"B",OI)) Q:OI'>0 S ^XTMP(SUB,IEN,OI)="",FOUND=1
I FOUND=0 D MES^XPDUTL(" None found") K ^XTMP(SUB) Q
D MES^XPDUTL(" DONE")
S MSG(1)=" Deleting existing orderable item data from REMINDER ORDER CHECK ITEMS GROUP"
D MES^XPDUTL(.MSG)
S IEN=0 F S IEN=$O(^XTMP(SUB,IEN)) Q:IEN'>0 K ^PXD(801,IEN,2)
D MES^XPDUTL(" DONE")
D MES^XPDUTL(" Removing old cross-references...")
K ^PXD(801,"AOIR"),^PXD(801,"O")
D MES^XPDUTL(" DONE")
Q
;
RENAME(CALLER) ;Rename components
N ITEMS,GLOBAL,ITEM,TEST,TYPES,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"
I $G(CALLER)="PRE-INSTALL" D
.S ITEMS("^PXD(811.9,","VA-TERATOGENIC MEDICATIONS ORDER CHECK")="VA-WH HIRISK ORDER CHECK - PREGNANT"
.S ITEMS("^PXD(801.1,","VA-TERATOGENIC MEDICATIONS ORDER CHECK (CAT D) RULE")="VA-WH HIRISK MEDS (MODERATE/HIGH RISK) PREG RULE"
.S ITEMS("^PXD(801.1,","VA-TERATOGENIC MEDICATIONS ORDER CHECK (CAT X) RULE")="VA-WH HIRISK MEDS (EXTREME RISK) PREG RULE"
.S ITEMS("^PXD(801,","VA-TERATOGENIC MEDICATIONS (CAT D OR C) GROUP")="VA-WH HIRISK MEDICATIONS (MOD/HIGH RISK DURING PREGNANCY) GROUP"
.S ITEMS("^PXD(801,","VA-TERATOGENIC MEDICATIONS (CAT X) GROUP")="VA-WH HIRISK MEDICATIONS (EXTREME RISK) GROUP"
.S ITEMS("^PXD(811.2,","VA-TERATOGENIC MEDICATIONS ORDER CHECK EXCL (TAXONOMIES)")="VA-WH TERATOGENIC MEDICATIONS EXCLUSIONS TAXONOMY"
I $G(CALLER)="POST-INSTALL" D
.S ITEMS("^PXRMD(811.5,","VA-TERATOGENIC MEDICATIONS ORDER CHECK EXCLUSIONS (TERM)")="@"
.S ITEMS("^PXRMD(811.5,","VA-WH IUD INSERTION (TERM)")="@"
.S ITEMS("^PXRMD(811.5,","VA-WH IUD REMOVAL (TERM)")="@"
I $G(CALLER)="BUILD265" D
.S ITEMS("^PXD(811.9,","VA-WH BLOCK PREGNANCY AND LACTATION DATA ENTRY")="VA-WH PREGNANCY AND LACTATION DATA ENTRY ALLOWED"
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
;
SENDIM ;Send install message.
N FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
S NODE="PXRM*2.0*45"
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
;
SETPARM() ;
N PROD
S PROD=$$PROD^XUPROD(1)
D PUT^XPAR("SYS","PXRM DIALOG EVAL DEFINITION",,0)
Q
;
UPDATE(FDA,SUB,NAME,IEN) ;
N MSG,NAME,OI,OINAME
D UPDATE^DIE("","FDA","","MSG")
I '$D(MSG) S ^XTMP(SUB,IEN,"DONE")=1 Q
;If error display error and original structures
I $D(MSG) D AWRITE^PXRMUTIL("MSG") D
.S ^XTMP(SUB,IEN,"DONE")=0
.D MES^XPDUTL("Manual correction is needed.")
.D MES^XPDUTL("Someone needs to manually move the orderable items listed below to the ITEMS LIST section.")
.D MES^XPDUTL("Reminder Group Name: "_$P($G(^PXD(801,IEN,0)),U))
.S OI=0 F S OI=$O(^XTMP(SUB,IEN,OI)) Q:OI'>0 D
..S OINAME=$P($G(^ORD(101.43,OI,0)),U) I OINAME="" Q
..D MES^XPDUTL(" "_OINAME)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP45I 9547 printed Dec 13, 2024@01:47:45 Page 2
PXRMP45I ;ISP/RFR - PATCH 45 INSTALLATION ;Jan 03, 2020@14:35
+1 ;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
+2 IF '$$PATCH^XPDUTL("PXRM*2.0*45")
Begin DoDot:1
+3 NEW ENTRY,ENTRIES
+4 SET ENTRIES("UPDATE_2_0_54 VA-TERATOGENIC MEDICATIONS ORDER CHECKS(UPDATE #4)")="06/25/2018@08:36:44"
+5 SET ENTRIES("UPDATE_2_0_16 VA-WH MAMMOGRAM SCREENING")="09/15/2017@05:59:09"
+6 SET ENTRY=""
FOR
SET ENTRY=$ORDER(ENTRIES(ENTRY))
if ENTRY=""
QUIT
IF +$$EXCHINCK(ENTRY,ENTRIES(ENTRY))<1
Begin DoDot:2
+7 WRITE !,ENTRY,!,"is not installed.",!
+8 SET XPDABORT=2
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
DLGTTL ;dialog and title text pairs for link code
+1 ;;VA-WH SMART PT NOTIFICATION^SMART PATIENT NOTIFICATION
+2 ;;VA-WH SMART BREAST IMAGING FOLLOW-UP^SMART BREAST IMAGING FOLLOW-UP^BREAST IMAGING FOLLOW-UP
+3 ;;VA-WH SMART BR OUTSIDE REPORT^SMART OUTSIDE BREAST IMAGE RESULTS
+4 ;;VA-WH UPDATE PREGNANCY STATUS^PREGNANCY STATUS UPDATE REVIEW^PREGNANCY/INTENTIONS/CONTRACEPTION
+5 ;;VA-WH UPDATE LACTATION STATUS^LACTATION STATUS UPDATE REVIEW^UPDATE LACTATION STATUS
+6 ;;EOF
+7 ;
EXCHINCK(EXNAME,DPACKED) ;Given the name and the date packed of an Exchange
+1 ;entry return:
+2 ; -1 if the entry does not exist
+3 ; 0 if it has never been installed
+4 ; 1^installation date/time
+5 IF $GET(EXNAME)=""
QUIT -1
+6 IF $GET(DPACKED)=""
QUIT -1
+7 NEW DTP,IEN,IND,LASTINDT
+8 DO DT^DILF("ST",DPACKED,.DTP)
+9 SET IEN=+$ORDER(^PXD(811.8,"B",EXNAME,DTP,""))
+10 IF IEN=0
QUIT -1
+11 SET IND=+$ORDER(^PXD(811.8,IEN,130,"B"),-1)
+12 IF IND=0
QUIT 0
+13 SET LASTINDT=$PIECE(^PXD(811.8,IEN,130,IND,0),U,1)
+14 QUIT 1_U_LASTINDT
+15 ;
FMERROR(MESSAGES) ;RETURN FILEMAN ERROR MESSAGE(S) AS STRING
+1 NEW ITEM,ERROR,ERRNUM,ERRORS
+2 SET ERROR=""
SET ERRNUM=0
+3 FOR
SET ERRNUM=$ORDER(MESSAGES("DIERR",ERRNUM))
if '+ERRNUM
QUIT
Begin DoDot:1
+4 if $DATA(ERRORS($GET(MESSAGES("DIERR",ERRNUM))))
QUIT
+5 SET ITEM=0
FOR
SET ITEM=$ORDER(MESSAGES("DIERR",ERRNUM,"TEXT",ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+6 SET ERROR=$SELECT(ERROR'="":ERROR_" ",1:"")_MESSAGES("DIERR",ERRNUM,"TEXT",ITEM)
End DoDot:2
+7 SET ERRORS=$GET(MESSAGES("DIERR",ERRNUM))
+8 IF ERRORS'=""
SET ERRORS(ERRORS)=""
End DoDot:1
+9 QUIT ERROR
+10 ;
LINK ;link dialogs, templates, notes
+1 DO BMES^XPDUTL(" Creating entries in shared templates...")
+2 NEW GLOBAL,REMDLG,TEMPNAME,TITLE,TEXTPAIR,TEXTCNT,TMPONLY
+3 SET GLOBAL="TIU(8925.1,"
SET TMPONLY=0
+4 FOR TEXTCNT=1:1
SET TEXTPAIR=$PIECE($TEXT(DLGTTL+TEXTCNT),";",3)
if TEXTPAIR="EOF"
QUIT
Begin DoDot:1
+5 SET REMDLG=$PIECE(TEXTPAIR,U)
SET TITLE=$PIECE(TEXTPAIR,U,2)
SET TEMPNAME=$PIECE(TEXTPAIR,U,3)
+6 DO LINK2TIU^PXRMDUTL(REMDLG,TITLE,TEMPNAME,TMPONLY,GLOBAL)
End DoDot:1
+7 DO MES^XPDUTL(" DONE")
+8 QUIT
+9 ;
LINK2WH ;update WV PROCEDURE TYPE file
+1 DO BMES^XPDUTL(" Updating WV PROCEDURE TYPE file entries...")
+2 NEW DA,DIE,DR,RTIEN,RTNAME,WHARRAY,WHIEN,WHNAME
+3 SET DIE="^WV(790.2,"
SET DR="3////^S X=RTIEN"
+4 SET WHARRAY("BREAST MRI")="VA-WH MRI OF THE BREASTS CODES"
+5 SET WHARRAY("BREAST ULTRASOUND")="VA-WH ULTRASOUND OF THE BREAST CODES"
+6 SET WHARRAY("MAMMOGRAM DX BILAT")="VA-WH MAMMOGRAM BILAT DIAGNOSTIC CODES"
+7 SET WHARRAY("MAMMOGRAM DX UNILAT")="VA-WH MAMMOGRAM UNILAT DIAGNOSTIC CODES"
+8 SET WHARRAY("MAMMOGRAM SCREENING")="VA-WH MAMMOGRAM SCREENING CODES"
+9 SET WHNAME=""
FOR
SET WHNAME=$ORDER(WHARRAY(WHNAME))
if WHNAME=""
QUIT
Begin DoDot:1
+10 SET RTNAME=WHARRAY(WHNAME)
+11 DO BMES^XPDUTL(" Updating WV Procedure Type "_WHNAME)
+12 SET WHIEN=$ORDER(^WV(790.2,"B",WHNAME,""))
IF WHIEN'>0
DO BMES^XPDUTL("Could not find entry: "_WHNAME)
QUIT
+13 SET RTIEN=$ORDER(^PXRMD(811.5,"B",RTNAME,""))
IF RTIEN'>0
DO BMES^XPDUTL("Could not find reminder term: "_RTNAME)
QUIT
+14 SET DA=WHIEN
+15 DO ^DIE
End DoDot:1
+16 DO MES^XPDUTL(" DONE")
+17 QUIT
+18 ;
POST ;Post-init
+1 NEW DIK,LUVALUE,LIST,DIK,DA,CNT,FDA,SUB,IEN,IENS,NAME,OI
+2 DO POSTOC
+3 DO BMES^XPDUTL(" Reindexing the DISPLAY NAME field in file #801.1...")
+4 SET DIK="^PXD(801.1,"
SET DIK(1)=1
DO ENALL2^DIK
DO ENALL^DIK
+5 DO MES^XPDUTL(" DONE")
+6 DO POST^PXRMP45D
DO REBUILD^PXRMP45D
+7 ;Install Exchange File entries.
+8 DO SMEXINS^PXRMEXSI("EXARRAY","PXRMP45E")
+9 DO SETPARM
DO RENAME("POST-INSTALL")
DO RENAME("BUILD265")
+10 ;Enable options and protocols
+11 DO OPTIONS^PXRMUTIL("ENABLE","Install of PXRM*2.0*45")
+12 DO PROTCOLS^PXRMUTIL("ENABLE","Install of PXRM*2.0*45")
+13 DO SETPVER^PXRMUTIL("2.0P45")
DO SENDIM
+14 KILL PXRMINST,PXRMINCF
+15 QUIT
+16 ;
POSTOC ;
+1 NEW CNT,DIK,DONE,FDA,IEN,IENS,NAME,OI,SUB
+2 SET SUB="PXRM ORDER CHECK CONVERSION"
+3 IF '$DATA(^XTMP(SUB))
QUIT
+4 DO BMES^XPDUTL(" Updating Reminder Order Check Groups...")
+5 SET IEN=0
FOR
SET IEN=$ORDER(^PXD(801,IEN))
if +IEN'>0
QUIT
Begin DoDot:1
+6 KILL FDA
SET CNT=0
IF '$DATA(^XTMP(SUB,IEN))
QUIT
+7 SET NAME=$PIECE($GET(^PXD(801,IEN,0)),U)
+8 DO MES^XPDUTL(" Updating group: "_NAME)
+9 SET OI=0
FOR
SET OI=$ORDER(^XTMP(SUB,IEN,OI))
if OI'>0
QUIT
Begin DoDot:2
+10 SET CNT=CNT+1
SET IENS="+"_CNT_","_IEN_","
+11 SET FDA(801.015,IENS,.01)=$SELECT(OI[";":OI,1:OI_";ORD(101.43,")
End DoDot:2
+12 IF $DATA(FDA)
DO UPDATE(.FDA,SUB,NAME,IEN)
End DoDot:1
+13 DO MES^XPDUTL(" DONE")
+14 DO BMES^XPDUTL(" Reindexing file #801...")
+15 SET DIK="^PXD(801,"
+16 DO IXALL2^DIK
DO IXALL^DIK
+17 SET IEN=0
SET DONE=1
FOR
SET IEN=$ORDER(^XTMP(SUB,IEN))
if +IEN'>0!(DONE=0)
QUIT
Begin DoDot:1
+18 IF +$GET(^XTMP(SUB,IEN,"DONE"))=0
SET DONE=0
End DoDot:1
+19 IF DONE=1
KILL ^XTMP(SUB)
+20 DO MES^XPDUTL(" DONE")
+21 QUIT
+22 ;
PRE ;Pre-init
+1 ;Disable options and protocols
+2 DO OPTIONS^PXRMUTIL("DISABLE","Install of PXRM*2.0*45")
+3 DO PROTCOLS^PXRMUTIL("DISABLE","Install of PXRM*2.0*45")
+4 DO DELEXE^PXRMEXSI("EXARRAY","PXRMP45E")
+5 SET (PXRMINST,PXRMINCF)=1
+6 DO PREOC
DO PRE^PXRMP45D
DO RENAME("PRE-INSTALL")
+7 ;Delete exisitng data dictionaries
+8 NEW DIU,DA,DIK,IEN,OI,SUB
+9 SET DIU(0)=""
+10 FOR DIU=801,801.41,801.46,801.47,801.48,811.8,811.9
DO MES^XPDUTL(" Deleting data dictionary for file #"_DIU_"...")
DO EN^DIU2
DO MES^XPDUTL(" DONE")
+11 QUIT
+12 ;
PREOC ;
+1 NEW FOUND,IEN,OI,SUB,MSG
+2 SET SUB="PXRM ORDER CHECK CONVERSION"
+3 KILL ^XTMP(SUB)
+4 SET ^XTMP(SUB,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"PXRM Patch 45 Order Check Conversion"
SET FOUND=0
+5 SET MSG(1)=" Copying existing orderable item data from REMINDER ORDER CHECK ITEMS GROUP"
SET MSG(2)=" file..."
+6 DO MES^XPDUTL(.MSG)
+7 SET IEN=0
FOR
SET IEN=$ORDER(^PXD(801,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+8 IF '$DATA(^PXD(801,IEN,2,"B"))
QUIT
+9 SET OI=0
FOR
SET OI=$ORDER(^PXD(801,IEN,2,"B",OI))
if OI'>0
QUIT
SET ^XTMP(SUB,IEN,OI)=""
SET FOUND=1
End DoDot:1
+10 IF FOUND=0
DO MES^XPDUTL(" None found")
KILL ^XTMP(SUB)
QUIT
+11 DO MES^XPDUTL(" DONE")
+12 SET MSG(1)=" Deleting existing orderable item data from REMINDER ORDER CHECK ITEMS GROUP"
+13 DO MES^XPDUTL(.MSG)
+14 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(SUB,IEN))
if IEN'>0
QUIT
KILL ^PXD(801,IEN,2)
+15 DO MES^XPDUTL(" DONE")
+16 DO MES^XPDUTL(" Removing old cross-references...")
+17 KILL ^PXD(801,"AOIR"),^PXD(801,"O")
+18 DO MES^XPDUTL(" DONE")
+19 QUIT
+20 ;
RENAME(CALLER) ;Rename components
+1 NEW ITEMS,GLOBAL,ITEM,TEST,TYPES,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 IF $GET(CALLER)="PRE-INSTALL"
Begin DoDot:1
+9 SET ITEMS("^PXD(811.9,","VA-TERATOGENIC MEDICATIONS ORDER CHECK")="VA-WH HIRISK ORDER CHECK - PREGNANT"
+10 SET ITEMS("^PXD(801.1,","VA-TERATOGENIC MEDICATIONS ORDER CHECK (CAT D) RULE")="VA-WH HIRISK MEDS (MODERATE/HIGH RISK) PREG RULE"
+11 SET ITEMS("^PXD(801.1,","VA-TERATOGENIC MEDICATIONS ORDER CHECK (CAT X) RULE")="VA-WH HIRISK MEDS (EXTREME RISK) PREG RULE"
+12 SET ITEMS("^PXD(801,","VA-TERATOGENIC MEDICATIONS (CAT D OR C) GROUP")="VA-WH HIRISK MEDICATIONS (MOD/HIGH RISK DURING PREGNANCY) GROUP"
+13 SET ITEMS("^PXD(801,","VA-TERATOGENIC MEDICATIONS (CAT X) GROUP")="VA-WH HIRISK MEDICATIONS (EXTREME RISK) GROUP"
+14 SET ITEMS("^PXD(811.2,","VA-TERATOGENIC MEDICATIONS ORDER CHECK EXCL (TAXONOMIES)")="VA-WH TERATOGENIC MEDICATIONS EXCLUSIONS TAXONOMY"
End DoDot:1
+15 IF $GET(CALLER)="POST-INSTALL"
Begin DoDot:1
+16 SET ITEMS("^PXRMD(811.5,","VA-TERATOGENIC MEDICATIONS ORDER CHECK EXCLUSIONS (TERM)")="@"
+17 SET ITEMS("^PXRMD(811.5,","VA-WH IUD INSERTION (TERM)")="@"
+18 SET ITEMS("^PXRMD(811.5,","VA-WH IUD REMOVAL (TERM)")="@"
End DoDot:1
+19 IF $GET(CALLER)="BUILD265"
Begin DoDot:1
+20 SET ITEMS("^PXD(811.9,","VA-WH BLOCK PREGNANCY AND LACTATION DATA ENTRY")="VA-WH PREGNANCY AND LACTATION DATA ENTRY ALLOWED"
End DoDot:1
+21 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
+22 SET TEST=GLOBAL_"""B"","""_ITEM_""",0)"
+23 SET IEN=+$ORDER(@TEST)
+24 if 'IEN
QUIT
+25 KILL MSG
+26 SET MSG(1)=" "_$SELECT(ITEMS(GLOBAL,ITEM)'="@":"Renaming",1:"Deleting")_" the "_ITEM
SET MSG(2)=" "_TYPES(GLOBAL)_"..."
+27 DO MES^XPDUTL(.MSG)
+28 IF ITEMS(GLOBAL,ITEM)="@"
DO DELTLFE^PXRMUTIL($PIECE($PIECE(GLOBAL,"(",2),","),ITEM)
+29 IF ITEMS(GLOBAL,ITEM)'="@"
DO RENAME^PXRMUTIL($PIECE($PIECE(GLOBAL,"(",2),","),ITEM,ITEMS(GLOBAL,ITEM))
+30 DO MES^XPDUTL(" DONE")
End DoDot:1
+31 QUIT
+32 ;
SENDIM ;Send install message.
+1 NEW FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
+2 SET NODE="PXRM*2.0*45"
+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 ;
SETPARM() ;
+1 NEW PROD
+2 SET PROD=$$PROD^XUPROD(1)
+3 DO PUT^XPAR("SYS","PXRM DIALOG EVAL DEFINITION",,0)
+4 QUIT
+5 ;
UPDATE(FDA,SUB,NAME,IEN) ;
+1 NEW MSG,NAME,OI,OINAME
+2 DO UPDATE^DIE("","FDA","","MSG")
+3 IF '$DATA(MSG)
SET ^XTMP(SUB,IEN,"DONE")=1
QUIT
+4 ;If error display error and original structures
+5 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
Begin DoDot:1
+6 SET ^XTMP(SUB,IEN,"DONE")=0
+7 DO MES^XPDUTL("Manual correction is needed.")
+8 DO MES^XPDUTL("Someone needs to manually move the orderable items listed below to the ITEMS LIST section.")
+9 DO MES^XPDUTL("Reminder Group Name: "_$PIECE($GET(^PXD(801,IEN,0)),U))
+10 SET OI=0
FOR
SET OI=$ORDER(^XTMP(SUB,IEN,OI))
if OI'>0
QUIT
Begin DoDot:2
+11 SET OINAME=$PIECE($GET(^ORD(101.43,OI,0)),U)
IF OINAME=""
QUIT
+12 DO MES^XPDUTL(" "_OINAME)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
