Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMP18I

PXRMP18I.m

Go to the documentation of this file.
  1. PXRMP18I ;SLC/PKR - Inits for PXRM*2.0*18. ;10/06/2011
  1. ;;2.0;CLINICAL REMINDERS;**18**;Feb 04, 2005;Build 152
  1. Q
  1. ;==========================================
  1. BSPONB ;Rebuild the B and BN index for the Sponsor file so it matches the
  1. ;length of the .01.
  1. N DIK
  1. S DIK="^PXRMD(811.6,"
  1. S DIK(1)=".01"
  1. D BMES^XPDUTL("Rebuilding Sponsor B and BN indexes.")
  1. K ^PXRMD(811.6,"B"),^PXRMD(811.6,"BN")
  1. D ENALL^DIK
  1. Q
  1. ;
  1. ;==========================================
  1. CDUERB ;Rebuild custom date due date structure
  1. N CDUE,IEN,NAME
  1. D BMES^XPDUTL("Rebuilding Custom Date Due data structures.")
  1. S NAME=""
  1. F S NAME=$O(^PXD(811.9,"B",NAME)) Q:NAME="" D
  1. . S IEN=$O(^PXD(811.9,"B",NAME,""))
  1. . S CDUE=$G(^PXD(811.9,IEN,45))
  1. . I CDUE="" Q
  1. . D CDKILL^PXRMCDUE(CDUE,IEN)
  1. . D CDBUILD^PXRMCDUE(CDUE,IEN)
  1. Q
  1. ;
  1. ;==========================================
  1. CFINC(Y) ;List of computed findings to include in the build.
  1. N CFLIST,CFNAME
  1. S CFLIST("VA-ACTIVE PATIENT RECORD FLAGS")=""
  1. S CFLIST("VA-APPOINTMENTS FOR A PATIENT")=""
  1. S CFLIST("VA-FILEMAN DATE")=""
  1. S CFLIST("VA-PCMM PATIENTS ASSIGNED TO A PRACTITIONER")=""
  1. S CFLIST("VA-PCMM PATIENTS ASSIGNED TO A TEAM")=""
  1. S CFLIST("VA-PCMM PC TEAM AND INSTITUTION")=""
  1. S CFLIST("VA-PCMM PRACTITIONERS ASSIGNED TO A PATIENT")=""
  1. S CFLIST("VA-PATIENT RECORD FLAG INFORMATION")=""
  1. S CFLIST("VA-PATIENT RECORD FLAG LIST")=""
  1. S CFLIST("VA-RANDOM NUMBER")=""
  1. S CFLIST("VA-WAS INPATIENT")=""
  1. ;S CFLIST("")=""
  1. S CFNAME=$P($G(^PXRMD(811.4,Y,0)),U)
  1. Q $S($D(CFLIST(CFNAME)):1,1:0)
  1. ;
  1. ;==========================================
  1. CFPRS ;Set the value of the CF PARAMETER REQUIRED field to YES for the
  1. ;national computed findings where it is required.
  1. D BMES^XPDUTL("Setting CF PARAMETER REQUIRED field for national computed findings.")
  1. N CFLIST,CFNAME,IEN
  1. S CFLIST("VA-ACTIVE PATIENT RECORD FLAGS")=""
  1. S CFLIST("VA-ADMISSIONS FOR A DATE RANGE")=""
  1. S CFLIST("VA-ALLERGY")=""
  1. S CFLIST("VA-APPOINTMENTS FOR A PATIENT")=""
  1. S CFLIST("VA-ASU USER CLASS")=""
  1. S CFLIST("VA-DATE FOR AGE")=""
  1. S CFLIST("VA-FILEMAN DATE")=""
  1. S CFLIST("VA-PATIENT RECORD FLAG INFORMATION")=""
  1. S CFLIST("VA-PATIENT RECORD FLAG LIST")=""
  1. S CFLIST("VA-PATIENTS WITH APPOINTMENTS")=""
  1. S CFLIST("VA-PCMM PATIENTS ASSIGNED TO A PRACTITIONER")=""
  1. S CFLIST("VA-PCMM PATIENTS ASSIGNED TO A TEAM")=""
  1. S CFLIST("VA-PROGRESS NOTE")=""
  1. S CFLIST("VA-RANDOM NUMBER")=""
  1. S CFLIST("VA-REMINDER DEFINITION")=""
  1. S CFNAME=""
  1. F S CFNAME=$O(CFLIST(CFNAME)) Q:CFNAME="" D
  1. . S IEN=$O(^PXRMD(811.4,"B",CFNAME,""))
  1. . I IEN="" Q
  1. . S $P(^PXRMD(811.4,IEN,0),U,6)=1
  1. Q
  1. ;
  1. ;==========================================
  1. DELDD ;Delete the old data dictionaries.
  1. N DIU,TEXT
  1. D EN^DDIOL("Removing old data dictionaries.")
  1. S DIU(0)=""
  1. F DIU=801.41,802.4,811.4,811.6,811.9 D
  1. . S TEXT=" Deleting data dictionary for file # "_DIU
  1. . D EN^DDIOL(TEXT)
  1. . D EN^DIU2
  1. Q
  1. ;
  1. ;==========================================
  1. DELFE ;Delete some file entries.
  1. D DELTLFE^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SPC&PLAN HF GP")
  1. D DELTLFE^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SPC&PLAN WP")
  1. ;
  1. D DELTLFE^PXRMUTIL(811.5,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN")
  1. Q
  1. ;
  1. ;==========================================
  1. FFCLEAN ;Remove pieces 4 and 5 from the 0 node of 802.4 since they are no
  1. ;longer defined.
  1. N IEN,ZTEMP
  1. S IEN=0
  1. F S IEN=+$O(^PXRMD(802.4,IEN)) Q:IEN=0 D
  1. . S ZTEMP=$P(^PXRMD(802.4,IEN,0),U,1,4)
  1. . S ^PXRMD(802.4,IEN,0)=ZTEMP
  1. Q
  1. ;
  1. ;==========================================
  1. INILT ;Initialize list templates
  1. ;N IEN,IND,LIST,TEMP0
  1. ;D LTL^PXRMP12I(.LIST)
  1. ;S IND=0
  1. ;IA #4123
  1. ;F S IND=$O(LIST(IND)) Q:IND="" D
  1. ;. S IEN=$O(^SD(409.61,"B",LIST(IND),"")) Q:IEN=""
  1. ;. S TEMP0=$G(^SD(409.61,IEN,0))
  1. ;. K ^SD(409.61,IEN)
  1. ;. S ^SD(409.61,IEN,0)=TEMP0
  1. Q
  1. ;
  1. ;==========================================
  1. LTL(LIST) ;This is the list of list templates that being distributed
  1. ;in the patch.
  1. ;S LIST(1)="PXRM EX LIST COMPONENTS"
  1. ;S LIST(2)="PXRM EX REMINDER EXCHANGE"
  1. Q
  1. ;
  1. ;==========================================
  1. PRE ;Pre-init
  1. ;Disable options and protocols
  1. D OPTION^PXRMUTIL("DISABLE")
  1. D PROTOCOL^PXRMUTIL("DISABLE")
  1. D RENAME^PXRMP18I
  1. D DELEXE^PXRMEXSI("EXARRAY","PXRMP18E")
  1. D DELDD^PXRMP18I
  1. Q
  1. ;
  1. ;==========================================
  1. POST ;Post-init
  1. D CDUERB^PXRMP18I
  1. ;Enable options and protocols
  1. D OPTION^PXRMUTIL("ENABLE")
  1. D PROTOCOL^PXRMUTIL("ENABLE")
  1. D SETPVER^PXRMUTIL("2.0P18")
  1. D FFCLEAN^PXRMP18I
  1. D BSPONB^PXRMP18I
  1. ;Install Exchange File entries.
  1. D SMEXINS^PXRMEXSI("EXARRAY","PXRMP18E")
  1. ;Make sure national computed finding print names start with VA-.
  1. D RCFPN^PXRMP18I
  1. D CFPRS^PXRMP18I
  1. D DELFE^PXRMP18I
  1. D SENDIM^PXRMP18I
  1. Q
  1. ;
  1. ;==========================================
  1. RENAME ;Rename various file entries.
  1. N PXRMINST
  1. S PXRMINST=1
  1. D RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN HF GP","VA-MH NOSHOW PLAN DEVELOPED HF GP")
  1. D RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN WP GP","VA-MH NOSHOW PLAN DEVELOPED WP GP")
  1. D RENAME^PXRMUTIL(801.41,"VA-MH NOSHOW CONSULT W/SUPRV&PLAN WP","VA-MH NOSHOW PLAN DEVELOPED WP")
  1. D RENAME^PXRMUTIL(801.41,"VA-MH SUICIDE ATTEMPT SBR&PLAN HF","VA-MH SUICIDE ATTEMPTED HF")
  1. D RENAME^PXRMUTIL(801.41,"VA-MH SUICIDE COMPLETED SBR HF","VA-MH SUICIDE COMPLETED HF")
  1. ;
  1. D RENAME^PXRMUTIL(802.4,"DIFF_DT","DTIME_DIFF")
  1. ;
  1. D RENAME^PXRMUTIL(811.5,"VA-MH NOSHOW INITIATE WELFARE CHECK","VA-MH NOSHOW INITIATE WELLNESS CHECK")
  1. D RENAME^PXRMUTIL(811.5,"VA-MH NOSHOW CONSULT W/SPC&PLAN","VA-MH NOSHOW PLAN DEVELOPED")
  1. D RENAME^PXRMUTIL(811.5,"VA-MH SUICIDE ATTEMPT SBR&PLAN","VA-MH SUICIDE ATTEMPTED")
  1. D RENAME^PXRMUTIL(811.5,"VA-MH SUICIDE COMPLETED SBR","VA-MH SUICIDE COMPLETED")
  1. ;
  1. D RENAME^PXRMUTIL(9999999.64,"MH NOSHOW INITIATE WELFARE CHECK","MH NOSHOW INITIATE WELLNESS CHECK")
  1. D RENAME^PXRMUTIL(9999999.64,"MH NOSHOW CONSULT W/SPC&PLAN","MH NOSHOW PLAN DEVELOPED")
  1. D RENAME^PXRMUTIL(9999999.64,"MH SUICIDE ATTEMPT-SBR&PLAN","MH SUICIDE ATTEMPTED")
  1. D RENAME^PXRMUTIL(9999999.64,"MH SUICIDE COMPLETED-SBR","MH SUICIDE COMPLETED")
  1. Q
  1. ;
  1. ;==========================================
  1. RCFPN ;Make sure the print names of all national computed findings
  1. ;start with VA-.
  1. N IEN,NAME,PNAME,TEXT
  1. D BMES^XPDUTL("Checking national computed finding print names.")
  1. S NAME=""
  1. F S NAME=$O(^PXRMD(811.4,"B",NAME)) Q:NAME="" D
  1. . S IEN=$O(^PXRMD(811.4,"B",NAME,""))
  1. . I $P(^PXRMD(811.4,IEN,100),U,1)'="N" Q
  1. . S PNAME=$P(^PXRMD(811.4,IEN,0),U,4)
  1. . I $E(PNAME,1,3)="VA-" Q
  1. . K TEXT
  1. . S TEXT(1)=" "
  1. . S TEXT(2)="CF "_NAME
  1. . S TEXT(3)="Print Name: "_PNAME
  1. . I (NAME="VA-PATIENT TYPE") S PNAME="Patient Type"
  1. . I (NAME="VA-TREATING FACILITY LIST") S PNAME="Treating Facility List"
  1. . I (NAME="VA-WH PAP SMEAR ABNORMAL IN WH PKG"),(PNAME="") D
  1. .. S PNAME="WH Pap Smear Abnormal in WH pkg"
  1. . I (NAME="VA-WH MAMMOGRAM ABNORMAL IN WH PKG"),(PNAME="") D
  1. .. S PNAME="WH Mammogram Abnormal in WH pkg"
  1. . S PNAME="VA-"_PNAME
  1. . S TEXT(4)="New print Name: "_PNAME
  1. . D MES^XPDUTL(.TEXT)
  1. . S $P(^PXRMD(811.4,IEN,0),U,4)=PNAME
  1. Q
  1. ;
  1. ;==========================================
  1. SENDIM ;Send install message.
  1. N FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
  1. S NODE="PXRM*2.0*18"
  1. K ^TMP(NODE,$J)
  1. ;DBIA #1131 for ^XMB("NETNAME")
  1. S FROM="PXRM*2.0*18 Install@"_^XMB("NETNAME")
  1. ;DBIA #2541
  1. S SYSTEM=$$KSP^XUPARAM("WHERE")
  1. I $$PROD^XUPROD(1) S TO("G.CLINICAL REMINDERS SUPPORT@DOMAIN.EXT")=""
  1. E D
  1. . N MGIEN,MGROUP
  1. . S MGIEN=$G(^PXRM(800,1,"MGFE"))
  1. . S MGROUP=$S(MGIEN'="":"G."_$$GET1^DIQ(3.8,MGIEN,.01),1:DUZ)
  1. . S TO(MGROUP)=""
  1. S SUBJECT="Install of PXRM*2.0*18"
  1. S ^TMP(NODE,$J,1,0)="PXRM*2.0*18 has been installed."
  1. S ^TMP(NODE,$J,2,0)="System is "_SYSTEM
  1. D SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
  1. Q
  1. ;