- PXRMP18I ;SLC/PKR - Inits for PXRM*2.0*18. ;10/06/2011
- ;;2.0;CLINICAL REMINDERS;**18**;Feb 04, 2005;Build 152
- Q
- ;==========================================
- BSPONB ;Rebuild the B and BN index for the Sponsor file so it matches the
- ;length of the .01.
- N DIK
- S DIK="^PXRMD(811.6,"
- S DIK(1)=".01"
- D BMES^XPDUTL("Rebuilding Sponsor B and BN indexes.")
- K ^PXRMD(811.6,"B"),^PXRMD(811.6,"BN")
- D ENALL^DIK
- Q
- ;
- ;==========================================
- CDUERB ;Rebuild custom date due date structure
- N CDUE,IEN,NAME
- D BMES^XPDUTL("Rebuilding Custom Date Due data structures.")
- S NAME=""
- F S NAME=$O(^PXD(811.9,"B",NAME)) Q:NAME="" D
- . S IEN=$O(^PXD(811.9,"B",NAME,""))
- . S CDUE=$G(^PXD(811.9,IEN,45))
- . I CDUE="" Q
- . D CDKILL^PXRMCDUE(CDUE,IEN)
- . D CDBUILD^PXRMCDUE(CDUE,IEN)
- Q
- ;
- ;==========================================
- CFINC(Y) ;List of computed findings to include in the build.
- N CFLIST,CFNAME
- S CFLIST("VA-ACTIVE PATIENT RECORD FLAGS")=""
- S CFLIST("VA-APPOINTMENTS FOR A PATIENT")=""
- S CFLIST("VA-FILEMAN DATE")=""
- S CFLIST("VA-PCMM PATIENTS ASSIGNED TO A PRACTITIONER")=""
- S CFLIST("VA-PCMM PATIENTS ASSIGNED TO A TEAM")=""
- S CFLIST("VA-PCMM PC TEAM AND INSTITUTION")=""
- S CFLIST("VA-PCMM PRACTITIONERS ASSIGNED TO A PATIENT")=""
- S CFLIST("VA-PATIENT RECORD FLAG INFORMATION")=""
- S CFLIST("VA-PATIENT RECORD FLAG LIST")=""
- S CFLIST("VA-RANDOM NUMBER")=""
- S CFLIST("VA-WAS INPATIENT")=""
- ;S CFLIST("")=""
- S CFNAME=$P($G(^PXRMD(811.4,Y,0)),U)
- Q $S($D(CFLIST(CFNAME)):1,1:0)
- ;
- ;==========================================
- CFPRS ;Set the value of the CF PARAMETER REQUIRED field to YES for the
- ;national computed findings where it is required.
- D BMES^XPDUTL("Setting CF PARAMETER REQUIRED field for national computed findings.")
- N CFLIST,CFNAME,IEN
- S CFLIST("VA-ACTIVE PATIENT RECORD FLAGS")=""
- S CFLIST("VA-ADMISSIONS FOR A DATE RANGE")=""
- S CFLIST("VA-ALLERGY")=""
- S CFLIST("VA-APPOINTMENTS FOR A PATIENT")=""
- S CFLIST("VA-ASU USER CLASS")=""
- S CFLIST("VA-DATE FOR AGE")=""
- S CFLIST("VA-FILEMAN DATE")=""
- S CFLIST("VA-PATIENT RECORD FLAG INFORMATION")=""
- S CFLIST("VA-PATIENT RECORD FLAG LIST")=""
- S CFLIST("VA-PATIENTS WITH APPOINTMENTS")=""
- S CFLIST("VA-PCMM PATIENTS ASSIGNED TO A PRACTITIONER")=""
- S CFLIST("VA-PCMM PATIENTS ASSIGNED TO A TEAM")=""
- S CFLIST("VA-PROGRESS NOTE")=""
- S CFLIST("VA-RANDOM NUMBER")=""
- S CFLIST("VA-REMINDER DEFINITION")=""
- S CFNAME=""
- F S CFNAME=$O(CFLIST(CFNAME)) Q:CFNAME="" D
- . S IEN=$O(^PXRMD(811.4,"B",CFNAME,""))
- . I IEN="" Q
- . S $P(^PXRMD(811.4,IEN,0),U,6)=1
- Q
- ;
- ;==========================================
- DELDD ;Delete the old data dictionaries.
- N DIU,TEXT
- D EN^DDIOL("Removing old data dictionaries.")
- S DIU(0)=""
- F DIU=801.41,802.4,811.4,811.6,811.9 D
- . S TEXT=" Deleting data dictionary for file # "_DIU
- . D EN^DDIOL(TEXT)
- . D EN^DIU2
- Q
- ;
- ;==========================================
- DELFE ;Delete some file entries.
- D DELTLFE^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SPC&PLAN HF GP")
- D DELTLFE^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SPC&PLAN WP")
- ;
- D DELTLFE^PXRMUTIL(811.5,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN")
- Q
- ;
- ;==========================================
- FFCLEAN ;Remove pieces 4 and 5 from the 0 node of 802.4 since they are no
- ;longer defined.
- N IEN,ZTEMP
- S IEN=0
- F S IEN=+$O(^PXRMD(802.4,IEN)) Q:IEN=0 D
- . S ZTEMP=$P(^PXRMD(802.4,IEN,0),U,1,4)
- . S ^PXRMD(802.4,IEN,0)=ZTEMP
- 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
- ;
- ;==========================================
- PRE ;Pre-init
- ;Disable options and protocols
- D OPTION^PXRMUTIL("DISABLE")
- D PROTOCOL^PXRMUTIL("DISABLE")
- D RENAME^PXRMP18I
- D DELEXE^PXRMEXSI("EXARRAY","PXRMP18E")
- D DELDD^PXRMP18I
- Q
- ;
- ;==========================================
- POST ;Post-init
- D CDUERB^PXRMP18I
- ;Enable options and protocols
- D OPTION^PXRMUTIL("ENABLE")
- D PROTOCOL^PXRMUTIL("ENABLE")
- D SETPVER^PXRMUTIL("2.0P18")
- D FFCLEAN^PXRMP18I
- D BSPONB^PXRMP18I
- ;Install Exchange File entries.
- D SMEXINS^PXRMEXSI("EXARRAY","PXRMP18E")
- ;Make sure national computed finding print names start with VA-.
- D RCFPN^PXRMP18I
- D CFPRS^PXRMP18I
- D DELFE^PXRMP18I
- D SENDIM^PXRMP18I
- Q
- ;
- ;==========================================
- RENAME ;Rename various file entries.
- N PXRMINST
- S PXRMINST=1
- D RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN HF GP","VA-MH NOSHOW PLAN DEVELOPED HF GP")
- D RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN WP GP","VA-MH NOSHOW PLAN DEVELOPED WP GP")
- D RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN WP","VA-MH NOSHOW PLAN DEVELOPED WP")
- D RENAME^PXRMUTIL(801.41,"VA-MH SUICIDE ATTEMPT SBR&PLAN HF","VA-MH SUICIDE ATTEMPTED HF")
- D RENAME^PXRMUTIL(801.41,"VA-MH SUICIDE COMPLETED SBR HF","VA-MH SUICIDE COMPLETED HF")
- ;
- D RENAME^PXRMUTIL(802.4,"DIFF_DT","DTIME_DIFF")
- ;
- D RENAME^PXRMUTIL(811.5,"VA-MH NOSHOW INITIATE WELFARE CHECK","VA-MH NOSHOW INITIATE WELLNESS CHECK")
- D RENAME^PXRMUTIL(811.5,"VA-MH NOSHOW CONSULT W/SPC&PLAN","VA-MH NOSHOW PLAN DEVELOPED")
- D RENAME^PXRMUTIL(811.5,"VA-MH SUICIDE ATTEMPT SBR&PLAN","VA-MH SUICIDE ATTEMPTED")
- D RENAME^PXRMUTIL(811.5,"VA-MH SUICIDE COMPLETED SBR","VA-MH SUICIDE COMPLETED")
- ;
- D RENAME^PXRMUTIL(9999999.64,"MH NOSHOW INITIATE WELFARE CHECK","MH NOSHOW INITIATE WELLNESS CHECK")
- D RENAME^PXRMUTIL(9999999.64,"MH NOSHOW CONSULT W/SPC&PLAN","MH NOSHOW PLAN DEVELOPED")
- D RENAME^PXRMUTIL(9999999.64,"MH SUICIDE ATTEMPT-SBR&PLAN","MH SUICIDE ATTEMPTED")
- D RENAME^PXRMUTIL(9999999.64,"MH SUICIDE COMPLETED-SBR","MH SUICIDE COMPLETED")
- Q
- ;
- ;==========================================
- RCFPN ;Make sure the print names of all national computed findings
- ;start with VA-.
- N IEN,NAME,PNAME,TEXT
- D BMES^XPDUTL("Checking national computed finding print names.")
- S NAME=""
- F S NAME=$O(^PXRMD(811.4,"B",NAME)) Q:NAME="" D
- . S IEN=$O(^PXRMD(811.4,"B",NAME,""))
- . I $P(^PXRMD(811.4,IEN,100),U,1)'="N" Q
- . S PNAME=$P(^PXRMD(811.4,IEN,0),U,4)
- . I $E(PNAME,1,3)="VA-" Q
- . K TEXT
- . S TEXT(1)=" "
- . S TEXT(2)="CF "_NAME
- . S TEXT(3)="Print Name: "_PNAME
- . I (NAME="VA-PATIENT TYPE") S PNAME="Patient Type"
- . I (NAME="VA-TREATING FACILITY LIST") S PNAME="Treating Facility List"
- . I (NAME="VA-WH PAP SMEAR ABNORMAL IN WH PKG"),(PNAME="") D
- .. S PNAME="WH Pap Smear Abnormal in WH pkg"
- . I (NAME="VA-WH MAMMOGRAM ABNORMAL IN WH PKG"),(PNAME="") D
- .. S PNAME="WH Mammogram Abnormal in WH pkg"
- . S PNAME="VA-"_PNAME
- . S TEXT(4)="New print Name: "_PNAME
- . D MES^XPDUTL(.TEXT)
- . S $P(^PXRMD(811.4,IEN,0),U,4)=PNAME
- Q
- ;
- ;==========================================
- SENDIM ;Send install message.
- N FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
- S NODE="PXRM*2.0*18"
- K ^TMP(NODE,$J)
- ;DBIA #1131 for ^XMB("NETNAME")
- S FROM="PXRM*2.0*18 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*18"
- S ^TMP(NODE,$J,1,0)="PXRM*2.0*18 has been installed."
- 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[HPXRMP18I 7920 printed Feb 18, 2025@23:13:31 Page 2
- PXRMP18I ;SLC/PKR - Inits for PXRM*2.0*18. ;10/06/2011
- +1 ;;2.0;CLINICAL REMINDERS;**18**;Feb 04, 2005;Build 152
- +2 QUIT
- +3 ;==========================================
- BSPONB ;Rebuild the B and BN index for the Sponsor file so it matches the
- +1 ;length of the .01.
- +2 NEW DIK
- +3 SET DIK="^PXRMD(811.6,"
- +4 SET DIK(1)=".01"
- +5 DO BMES^XPDUTL("Rebuilding Sponsor B and BN indexes.")
- +6 KILL ^PXRMD(811.6,"B"),^PXRMD(811.6,"BN")
- +7 DO ENALL^DIK
- +8 QUIT
- +9 ;
- +10 ;==========================================
- CDUERB ;Rebuild custom date due date structure
- +1 NEW CDUE,IEN,NAME
- +2 DO BMES^XPDUTL("Rebuilding Custom Date Due data structures.")
- +3 SET NAME=""
- +4 FOR
- SET NAME=$ORDER(^PXD(811.9,"B",NAME))
- if NAME=""
- QUIT
- Begin DoDot:1
- +5 SET IEN=$ORDER(^PXD(811.9,"B",NAME,""))
- +6 SET CDUE=$GET(^PXD(811.9,IEN,45))
- +7 IF CDUE=""
- QUIT
- +8 DO CDKILL^PXRMCDUE(CDUE,IEN)
- +9 DO CDBUILD^PXRMCDUE(CDUE,IEN)
- End DoDot:1
- +10 QUIT
- +11 ;
- +12 ;==========================================
- CFINC(Y) ;List of computed findings to include in the build.
- +1 NEW CFLIST,CFNAME
- +2 SET CFLIST("VA-ACTIVE PATIENT RECORD FLAGS")=""
- +3 SET CFLIST("VA-APPOINTMENTS FOR A PATIENT")=""
- +4 SET CFLIST("VA-FILEMAN DATE")=""
- +5 SET CFLIST("VA-PCMM PATIENTS ASSIGNED TO A PRACTITIONER")=""
- +6 SET CFLIST("VA-PCMM PATIENTS ASSIGNED TO A TEAM")=""
- +7 SET CFLIST("VA-PCMM PC TEAM AND INSTITUTION")=""
- +8 SET CFLIST("VA-PCMM PRACTITIONERS ASSIGNED TO A PATIENT")=""
- +9 SET CFLIST("VA-PATIENT RECORD FLAG INFORMATION")=""
- +10 SET CFLIST("VA-PATIENT RECORD FLAG LIST")=""
- +11 SET CFLIST("VA-RANDOM NUMBER")=""
- +12 SET CFLIST("VA-WAS INPATIENT")=""
- +13 ;S CFLIST("")=""
- +14 SET CFNAME=$PIECE($GET(^PXRMD(811.4,Y,0)),U)
- +15 QUIT $SELECT($DATA(CFLIST(CFNAME)):1,1:0)
- +16 ;
- +17 ;==========================================
- CFPRS ;Set the value of the CF PARAMETER REQUIRED field to YES for the
- +1 ;national computed findings where it is required.
- +2 DO BMES^XPDUTL("Setting CF PARAMETER REQUIRED field for national computed findings.")
- +3 NEW CFLIST,CFNAME,IEN
- +4 SET CFLIST("VA-ACTIVE PATIENT RECORD FLAGS")=""
- +5 SET CFLIST("VA-ADMISSIONS FOR A DATE RANGE")=""
- +6 SET CFLIST("VA-ALLERGY")=""
- +7 SET CFLIST("VA-APPOINTMENTS FOR A PATIENT")=""
- +8 SET CFLIST("VA-ASU USER CLASS")=""
- +9 SET CFLIST("VA-DATE FOR AGE")=""
- +10 SET CFLIST("VA-FILEMAN DATE")=""
- +11 SET CFLIST("VA-PATIENT RECORD FLAG INFORMATION")=""
- +12 SET CFLIST("VA-PATIENT RECORD FLAG LIST")=""
- +13 SET CFLIST("VA-PATIENTS WITH APPOINTMENTS")=""
- +14 SET CFLIST("VA-PCMM PATIENTS ASSIGNED TO A PRACTITIONER")=""
- +15 SET CFLIST("VA-PCMM PATIENTS ASSIGNED TO A TEAM")=""
- +16 SET CFLIST("VA-PROGRESS NOTE")=""
- +17 SET CFLIST("VA-RANDOM NUMBER")=""
- +18 SET CFLIST("VA-REMINDER DEFINITION")=""
- +19 SET CFNAME=""
- +20 FOR
- SET CFNAME=$ORDER(CFLIST(CFNAME))
- if CFNAME=""
- QUIT
- Begin DoDot:1
- +21 SET IEN=$ORDER(^PXRMD(811.4,"B",CFNAME,""))
- +22 IF IEN=""
- QUIT
- +23 SET $PIECE(^PXRMD(811.4,IEN,0),U,6)=1
- End DoDot:1
- +24 QUIT
- +25 ;
- +26 ;==========================================
- 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=801.41,802.4,811.4,811.6,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 ;==========================================
- DELFE ;Delete some file entries.
- +1 DO DELTLFE^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SPC&PLAN HF GP")
- +2 DO DELTLFE^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SPC&PLAN WP")
- +3 ;
- +4 DO DELTLFE^PXRMUTIL(811.5,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN")
- +5 QUIT
- +6 ;
- +7 ;==========================================
- FFCLEAN ;Remove pieces 4 and 5 from the 0 node of 802.4 since they are no
- +1 ;longer defined.
- +2 NEW IEN,ZTEMP
- +3 SET IEN=0
- +4 FOR
- SET IEN=+$ORDER(^PXRMD(802.4,IEN))
- if IEN=0
- QUIT
- Begin DoDot:1
- +5 SET ZTEMP=$PIECE(^PXRMD(802.4,IEN,0),U,1,4)
- +6 SET ^PXRMD(802.4,IEN,0)=ZTEMP
- End DoDot:1
- +7 QUIT
- +8 ;
- +9 ;==========================================
- 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 ;==========================================
- PRE ;Pre-init
- +1 ;Disable options and protocols
- +2 DO OPTION^PXRMUTIL("DISABLE")
- +3 DO PROTOCOL^PXRMUTIL("DISABLE")
- +4 DO RENAME^PXRMP18I
- +5 DO DELEXE^PXRMEXSI("EXARRAY","PXRMP18E")
- +6 DO DELDD^PXRMP18I
- +7 QUIT
- +8 ;
- +9 ;==========================================
- POST ;Post-init
- +1 DO CDUERB^PXRMP18I
- +2 ;Enable options and protocols
- +3 DO OPTION^PXRMUTIL("ENABLE")
- +4 DO PROTOCOL^PXRMUTIL("ENABLE")
- +5 DO SETPVER^PXRMUTIL("2.0P18")
- +6 DO FFCLEAN^PXRMP18I
- +7 DO BSPONB^PXRMP18I
- +8 ;Install Exchange File entries.
- +9 DO SMEXINS^PXRMEXSI("EXARRAY","PXRMP18E")
- +10 ;Make sure national computed finding print names start with VA-.
- +11 DO RCFPN^PXRMP18I
- +12 DO CFPRS^PXRMP18I
- +13 DO DELFE^PXRMP18I
- +14 DO SENDIM^PXRMP18I
- +15 QUIT
- +16 ;
- +17 ;==========================================
- RENAME ;Rename various file entries.
- +1 NEW PXRMINST
- +2 SET PXRMINST=1
- +3 DO RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN HF GP","VA-MH NOSHOW PLAN DEVELOPED HF GP")
- +4 DO RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN WP GP","VA-MH NOSHOW PLAN DEVELOPED WP GP")
- +5 DO RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN WP","VA-MH NOSHOW PLAN DEVELOPED WP")
- +6 DO RENAME^PXRMUTIL(801.41,"VA-MH SUICIDE ATTEMPT SBR&PLAN HF","VA-MH SUICIDE ATTEMPTED HF")
- +7 DO RENAME^PXRMUTIL(801.41,"VA-MH SUICIDE COMPLETED SBR HF","VA-MH SUICIDE COMPLETED HF")
- +8 ;
- +9 DO RENAME^PXRMUTIL(802.4,"DIFF_DT","DTIME_DIFF")
- +10 ;
- +11 DO RENAME^PXRMUTIL(811.5,"VA-MH NOSHOW INITIATE WELFARE CHECK","VA-MH NOSHOW INITIATE WELLNESS CHECK")
- +12 DO RENAME^PXRMUTIL(811.5,"VA-MH NOSHOW CONSULT W/SPC&PLAN","VA-MH NOSHOW PLAN DEVELOPED")
- +13 DO RENAME^PXRMUTIL(811.5,"VA-MH SUICIDE ATTEMPT SBR&PLAN","VA-MH SUICIDE ATTEMPTED")
- +14 DO RENAME^PXRMUTIL(811.5,"VA-MH SUICIDE COMPLETED SBR","VA-MH SUICIDE COMPLETED")
- +15 ;
- +16 DO RENAME^PXRMUTIL(9999999.64,"MH NOSHOW INITIATE WELFARE CHECK","MH NOSHOW INITIATE WELLNESS CHECK")
- +17 DO RENAME^PXRMUTIL(9999999.64,"MH NOSHOW CONSULT W/SPC&PLAN","MH NOSHOW PLAN DEVELOPED")
- +18 DO RENAME^PXRMUTIL(9999999.64,"MH SUICIDE ATTEMPT-SBR&PLAN","MH SUICIDE ATTEMPTED")
- +19 DO RENAME^PXRMUTIL(9999999.64,"MH SUICIDE COMPLETED-SBR","MH SUICIDE COMPLETED")
- +20 QUIT
- +21 ;
- +22 ;==========================================
- RCFPN ;Make sure the print names of all national computed findings
- +1 ;start with VA-.
- +2 NEW IEN,NAME,PNAME,TEXT
- +3 DO BMES^XPDUTL("Checking national computed finding print names.")
- +4 SET NAME=""
- +5 FOR
- SET NAME=$ORDER(^PXRMD(811.4,"B",NAME))
- if NAME=""
- QUIT
- Begin DoDot:1
- +6 SET IEN=$ORDER(^PXRMD(811.4,"B",NAME,""))
- +7 IF $PIECE(^PXRMD(811.4,IEN,100),U,1)'="N"
- QUIT
- +8 SET PNAME=$PIECE(^PXRMD(811.4,IEN,0),U,4)
- +9 IF $EXTRACT(PNAME,1,3)="VA-"
- QUIT
- +10 KILL TEXT
- +11 SET TEXT(1)=" "
- +12 SET TEXT(2)="CF "_NAME
- +13 SET TEXT(3)="Print Name: "_PNAME
- +14 IF (NAME="VA-PATIENT TYPE")
- SET PNAME="Patient Type"
- +15 IF (NAME="VA-TREATING FACILITY LIST")
- SET PNAME="Treating Facility List"
- +16 IF (NAME="VA-WH PAP SMEAR ABNORMAL IN WH PKG")
- IF (PNAME="")
- Begin DoDot:2
- +17 SET PNAME="WH Pap Smear Abnormal in WH pkg"
- End DoDot:2
- +18 IF (NAME="VA-WH MAMMOGRAM ABNORMAL IN WH PKG")
- IF (PNAME="")
- Begin DoDot:2
- +19 SET PNAME="WH Mammogram Abnormal in WH pkg"
- End DoDot:2
- +20 SET PNAME="VA-"_PNAME
- +21 SET TEXT(4)="New print Name: "_PNAME
- +22 DO MES^XPDUTL(.TEXT)
- +23 SET $PIECE(^PXRMD(811.4,IEN,0),U,4)=PNAME
- End DoDot:1
- +24 QUIT
- +25 ;
- +26 ;==========================================
- SENDIM ;Send install message.
- +1 NEW FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
- +2 SET NODE="PXRM*2.0*18"
- +3 KILL ^TMP(NODE,$JOB)
- +4 ;DBIA #1131 for ^XMB("NETNAME")
- +5 SET FROM="PXRM*2.0*18 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*18"
- +15 SET ^TMP(NODE,$JOB,1,0)="PXRM*2.0*18 has been installed."
- +16 SET ^TMP(NODE,$JOB,2,0)="System is "_SYSTEM
- +17 DO SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
- +18 QUIT
- +19 ;